X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/01778b39c53316dda3f757c49276d034039ee9cb..4ee476bc29b80fca2faabb4bd286ca70c98f7a44:/src/builtin.lisp?ds=sidebyside diff --git a/src/builtin.lisp b/src/builtin.lisp index 77eca39..7357752 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -279,7 +279,7 @@ (default (sod-initarg-default initarg))) (definst suppliedp-struct (stream) (flags var) (format stream - "~@" + "~@" flags var)) ;; Initialization. @@ -295,15 +295,28 @@ (defmethod sod-message-effective-method-class '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 (format nil "initargs for ~A" - class) - (mapcar #'sod-initarg-argument - initargs)))))) + (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)))))