X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/4b64aeef18655c33e033e9e0eadf939f51581d5e..489173a51e3020f7e0f73208c92ba0a03e21e048:/src/builtin.lisp diff --git a/src/builtin.lisp b/src/builtin.lisp index c49f263..5897da0 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -279,7 +279,7 @@ static const SodClass *const ~A__cpl[] = { (definst suppliedp-struct (stream) (flags var) (format stream - "~@" + "~@" flags var)) ;; Initialization. @@ -295,15 +295,28 @@ static const SodClass *const ~A__cpl[] = { 'initialization-effective-method) (defmethod method-keyword-argument-lists - ((method initialization-effective-method) direct-methods) + ((method initialization-effective-method) direct-methods state) (append (call-next-method) (mapcan (lambda (class) - (let ((initargs (sod-class-initargs class))) + (let* ((initargs (sod-class-initargs class)) + (map (make-hash-table)) + (arglist (mapcar + (lambda (initarg) + (let ((arg (sod-initarg-argument + initarg))) + (setf (gethash arg map) initarg) + arg)) + initargs))) (and initargs - (list (cons (mapcar #'sod-initarg-argument - initargs) - (format nil "initargs for ~A" - class)))))) + (list (cons (lambda (arg) + (info-with-location + (gethash arg map) + "Type `~A' from initarg ~ + in class `~A' (here)" + (argument-type arg) class) + (report-inheritance-path + state class)) + arglist))))) (sod-class-precedence-list (effective-method-class method))))) @@ -504,9 +517,11 @@ static const SodClass *const ~A__cpl[] = { instance of `SodClass', and `SodClass' is a subclass of `SodObject' (and an instance of itself)." (let* ((sod-object (make-sod-class "SodObject" nil - (make-property-set :nick 'obj))) + (make-property-set :nick 'obj + :%bootstrapping t))) (sod-class (make-sod-class "SodClass" (list sod-object) - (make-property-set :nick 'cls))) + (make-property-set :nick 'cls + :%bootstrapping t))) (classes (list sod-object sod-class))) ;; Attach the built-in messages. @@ -539,7 +554,8 @@ static const SodClass *const ~A__cpl[] = { ;; Done. (dolist (class classes) - (finalize-sod-class class) + (unless (finalize-sod-class class) + (error "Failed to finalize built-in class")) (add-to-module module class)))) (export '*builtin-module*)