invokes the debugger: "B is not of type list".
SBCL does the same thing.
+82:
+ Functions are assigned names based on the context in which they're
+ defined. This is less than ideal for the functions which are
+ used to implement CLOS methods. E.g. the output of
+ (DESCRIBE 'PRINT-OBJECT) lists functions like
+ #<FUNCTION "DEF!STRUCT (TRACE-INFO (:MAKE-LOAD-FORM-FUN SB-KERNEL:JUST-DUMP-IT-NORMALLY) (:PRINT-OBJECT #))" {1020E49}>
+ and
+ #<FUNCTION "MACROLET ((FORCE-DELAYED-DEF!METHODS NIL #))" {1242871}>
+ It would be better if these functions' names always identified
+ them as methods, and identified their generic functions and
+ specializers.
+
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
;;; Print the specified kind of documentation about the given NAME. If
;;; NAME is null, or not a valid name, then don't print anything.
-(declaim (ftype (function (symbol stream t t) (values)) %describe-doc))
+(declaim (ftype (function (t stream t t) (values)) %describe-doc))
(defun %describe-doc (name s kind kind-doc)
(when (and name (typep name '(or symbol cons)))
(let ((doc (fdocumentation name kind)))
(values))
;;; Describe various stuff about the functional semantics attached to
-;;; the specified Name. Type-Spec is the function type specifier
+;;; the specified NAME, if NAME is the kind of thing you can look
+;;; up as a name. (In the case of anonymous closures and other
+;;; things, it might not be.) TYPE-SPEC is the function type specifier
;;; extracted from the definition, or NIL if none.
-(declaim (ftype (function ((or symbol cons) stream t)) %describe-function-name))
+(declaim (ftype (function (t stream t)) %describe-function-name))
(defun %describe-function-name (name s type-spec)
- (multiple-value-bind (type where)
- (if (or (symbolp name) (and (listp name) (eq (car name) 'setf)))
- (values (type-specifier (info :function :type name))
- (info :function :where-from name))
- (values type-spec :defined))
- (when (consp type)
- (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S"
- where (second type))
- (format s "~@:_Its result type is:~@:_ ~S" (third type))))
- (let ((inlinep (info :function :inlinep name)))
- (when inlinep
- (format s "~@:_It is currently declared ~(~A~);~
+ (when (and name (typep name '(or symbol cons)))
+ (multiple-value-bind (type where)
+ (if (or (symbolp name) (and (listp name) (eq (car name) 'setf)))
+ (values (type-specifier (info :function :type name))
+ (info :function :where-from name))
+ (values type-spec :defined))
+ (when (consp type)
+ (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S"
+ where (second type))
+ (format s "~@:_Its result type is:~@:_ ~S" (third type))))
+ (let ((inlinep (info :function :inlinep name)))
+ (when inlinep
+ (format s
+ "~@:_It is currently declared ~(~A~);~
~:[no~;~] expansion is available."
- inlinep (info :function :inline-expansion name)))))
+ inlinep (info :function :inline-expansion name))))))
;;; Interpreted function describing; handles both closure and
;;; non-closure functions. Instead of printing the compiled-from info,
;;; early definition. Do this in a way that makes sure that if we
;;; redefine one of the early definitions the redefinition will take
;;; effect. This makes development easier.
-(eval-when (:load-toplevel :execute)
-
(dolist (fns *!early-functions*)
(let ((name (car fns))
(early-name (cadr fns)))
(lambda (&rest args)
(apply (fdefinition early-name) args))
name))))
-) ; EVAL-WHEN
;;; *!GENERIC-FUNCTION-FIXUPS* is used by !FIX-EARLY-GENERIC-FUNCTIONS
;;; to convert the few functions in the bootstrap which are supposed
;; prefixes.)
(*package* sb-int:*keyword-package*))
(format nil "~S" mname)))))
- `(eval-when (:load-toplevel :execute)
- (defun ,mname-sym ,(cadr fn-lambda)
- ,@(cddr fn-lambda))
- ,(make-defmethod-form-internal
- name qualifiers `',specls
- unspecialized-lambda-list method-class-name
- `(list* ,(cadr initargs-form)
- #',mname-sym
- ,@(cdddr initargs-form))
- pv-table-symbol)))
- (make-defmethod-form-internal
- name qualifiers
- `(list ,@(mapcar #'(lambda (specializer)
- (if (consp specializer)
- ``(,',(car specializer)
- ,,(cadr specializer))
- `',specializer))
- specializers))
- unspecialized-lambda-list method-class-name
- initargs-form
- pv-table-symbol))))
+ `(progn
+ (defun ,mname-sym ,(cadr fn-lambda)
+ ,@(cddr fn-lambda))
+ ,(make-defmethod-form-internal
+ name qualifiers `',specls
+ unspecialized-lambda-list method-class-name
+ `(list* ,(cadr initargs-form)
+ #',mname-sym
+ ,@(cdddr initargs-form))
+ pv-table-symbol)))
+ (make-defmethod-form-internal
+ name qualifiers
+ `(list ,@(mapcar #'(lambda (specializer)
+ (if (consp specializer)
+ ``(,',(car specializer)
+ ,,(cadr specializer))
+ `',specializer))
+ specializers))
+ unspecialized-lambda-list method-class-name
+ initargs-form
+ pv-table-symbol))))
(defun make-defmethod-form-internal
(name qualifiers specializers-form unspecialized-lambda-list
(cons (if (listp arg) (cadr arg) t) specializers)
(cons (if (listp arg) (car arg) arg) required)))))))
\f
-(eval-when (:load-toplevel :execute)
- (setq *boot-state* 'early))
+(setq *boot-state* 'early)
\f
;;; FIXME: In here there was a #-CMU definition of SYMBOL-MACROLET
;;; which used %WALKER stuff. That suggests to me that maybe the code
mclass
*the-class-structure-class*))))))
(let ((defclass-form
- (eval-when (:load-toplevel :execute)
- `(progn
- ,@(mapcar #'(lambda (x)
- `(declaim (ftype (function (t) t) ,x)))
- *readers*)
- ,@(mapcar #'(lambda (x)
- `(declaim (ftype (function (t t) t) ,x)))
- *writers*)
- (let ,(mapcar #'cdr *initfunctions*)
- (load-defclass ',name
- ',metaclass
- ',supers
- (list ,@canonical-slots)
- (list ,@(apply #'append
- (when defstruct-p
- '(:from-defclass-p t))
- other-initargs))))))))
+ `(progn
+ ,@(mapcar (lambda (x)
+ `(declaim (ftype (function (t) t) ,x)))
+ *readers*)
+ ,@(mapcar (lambda (x)
+ `(declaim (ftype (function (t t) t) ,x)))
+ *writers*)
+ (let ,(mapcar #'cdr *initfunctions*)
+ (load-defclass ',name
+ ',metaclass
+ ',supers
+ (list ,@canonical-slots)
+ (list ,@(apply #'append
+ (when defstruct-p
+ '(:from-defclass-p t))
+ other-initargs)))))))
(if defstruct-p
(progn
(eval defclass-form) ; Define the class now, so that..
(in-package "SB-PCL")
\f
-
-(eval-when (:load-toplevel :execute)
- (when (eq *boot-state* 'complete)
- (error "Trying to load (or compile) PCL in an environment in which it~%~
- has already been loaded. This doesn't work, you will have to~%~
- get a fresh lisp (reboot) and then load PCL."))
- (when *boot-state*
- (cerror "Try loading (or compiling) PCL anyways."
- "Trying to load (or compile) PCL in an environment in which it~%~
- has already been partially loaded. This may not work, you may~%~
- need to get a fresh lisp (reboot) and then load PCL."))
- ) ; EVAL-WHEN
+;;; (These are left over from the days when PCL was an add-on package
+;;; for a pre-CLOS Common Lisp. They shouldn't happen in a normal
+;;; build, of course, but they might happen if someone is experimenting
+;;; and debugging, and it's probably worth complaining if they do,
+;;; so we've left 'em in.)
+(when (eq *boot-state* 'complete)
+ (error "Trying to load (or compile) PCL in an environment in which it~%~
+ has already been loaded. This doesn't work, you will have to~%~
+ get a fresh lisp (reboot) and then load PCL."))
+(when *boot-state*
+ (cerror "Try loading (or compiling) PCL anyways."
+ "Trying to load (or compile) PCL in an environment in which it~%~
+ has already been partially loaded. This may not work, you may~%~
+ need to get a fresh lisp (reboot) and then load PCL."))
\f
;;; comments from CMU CL version of PCL:
;;; This is like fdefinition on the Lispm. If Common Lisp had
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.10.21"
+"0.6.10.22"
projects / sbcl.git / commitdiff