(Also, verify that the compiler handles declared function
return types as assertions.)
-41:
- TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in
- (DEFTYPE INDEXOID () '(INTEGER 0 1000))
- (DEFUN FOO (X)
- (DECLARE (TYPE INDEXOID X))
- (THE (VALUES INDEXOID)
- (VALUES X)))
- where the implementation of the type check in function FOO
- includes a full call to %TYPEP. There are also some fundamental problems
- with the interpretation of VALUES types (inherited from CMU CL, and
- from the ANSI CL standard) as discussed on the cmucl-imp@cons.org
- mailing list, e.g. in Robert Maclachlan's post of 21 Jun 2000.
-
42:
The definitions of SIGCONTEXT-FLOAT-REGISTER and
%SET-SIGCONTEXT-FLOAT-REGISTER in x86-vm.lisp say they're not
to redo MIX using a lookup into a 256-entry s-box containing
29-bit pseudorandom numbers?
-208: "package confusion in PCL handling of structure slot handlers"
- In sbcl-0.7.8 compiling and loading
- (in-package :cl)
- (defstruct foo (slot (error "missing")) :type list :read-only t)
- (defmethod print-object ((foo foo) stream) (print nil stream))
- causes CERROR "attempting to modify a symbol in the COMMON-LISP
- package: FOO-SLOT". (This is fairly bad code, but still it's hard
- to see that it should cause symbols to be interned in the CL package.)
-
211: "keywords processing"
a. :ALLOW-OTHER-KEYS T should allow a function to receive an odd
number of keyword arguments.
produce invalid code, but type checking is not accurate. Similar
problems exist with VALUES-TYPE-INTERSECTION.)
-218: "VALUES type specifier semantics"
- (THE (VALUES ...) ...) in safe code discards extra values.
-
- (defun test (x y) (the (values integer) (truncate x y)))
- (test 10 4) => 2
-
220:
Sbcl 0.7.9 fails to compile
would be to put the check between evaluation of arguments, but it
could be tricky to check result types of PROG1, IF etc.
-229:
- (subtypep 'function '(function)) => nil, t.
-
233: bugs in constraint propagation
a.
(defun foo (x)
res
(error "class not yet defined:~% ~S" name))))
(defun (setf find-classoid) (new-value name)
- #-sb-xc (declare (type classoid new-value))
- (ecase (info :type :kind name)
- ((nil))
- (:forthcoming-defclass-type
- ;; XXX Currently, nothing needs to be done in this case. Later, when
- ;; PCL is integrated tighter into SBCL, this might need more work.
- nil)
- (:instance
- ;; KLUDGE: The reason these clauses aren't directly parallel is
- ;; that we need to use the internal CLASSOID structure ourselves,
- ;; because we don't have CLASSes to work with until PCL is built.
- ;; In the host, CLASSes have an approximately one-to-one
- ;; correspondence with the target CLASSOIDs (as well as with the
- ;; target CLASSes, modulo potential differences with respect to
- ;; conditions).
- #+sb-xc-host
- (let ((old (class-of (find-classoid name)))
- (new (class-of new-value)))
- (unless (eq old new)
- (bug "trying to change the metaclass of ~S from ~S to ~S in the ~
- cross-compiler."
- name (class-name old) (class-name new))))
- #-sb-xc-host
- (let ((old (classoid-of (find-classoid name)))
- (new (classoid-of new-value)))
- (unless (eq old new)
- (warn "changing meta-class of ~S from ~S to ~S"
- name (classoid-name old) (classoid-name new)))))
- (:primitive
- (error "illegal to redefine standard type ~S" name))
- (:defined
- (warn "redefining DEFTYPE type to be a class: ~S" name)
- (setf (info :type :expander name) nil)))
+ #-sb-xc (declare (type (or null classoid) new-value))
+ (cond
+ ((null new-value)
+ (ecase (info :type :kind name)
+ ((nil))
+ (:defined)
+ (:primitive
+ (error "attempt to redefine :PRIMITIVE type: ~S" name))
+ ((:forthcoming-defclass-type :instance)
+ (setf (info :type :kind name) nil
+ (info :type :classoid name) nil
+ (info :type :documentation name) nil
+ (info :type :compiler-layout name) nil))))
+ (t
+ (ecase (info :type :kind name)
+ ((nil))
+ (:forthcoming-defclass-type
+ ;; XXX Currently, nothing needs to be done in this
+ ;; case. Later, when PCL is integrated tighter into SBCL, this
+ ;; might need more work.
+ nil)
+ (:instance
+ ;; KLUDGE: The reason these clauses aren't directly parallel
+ ;; is that we need to use the internal CLASSOID structure
+ ;; ourselves, because we don't have CLASSes to work with until
+ ;; PCL is built. In the host, CLASSes have an approximately
+ ;; one-to-one correspondence with the target CLASSOIDs (as
+ ;; well as with the target CLASSes, modulo potential
+ ;; differences with respect to conditions).
+ #+sb-xc-host
+ (let ((old (class-of (find-classoid name)))
+ (new (class-of new-value)))
+ (unless (eq old new)
+ (bug "trying to change the metaclass of ~S from ~S to ~S in the ~
+ cross-compiler."
+ name (class-name old) (class-name new))))
+ #-sb-xc-host
+ (let ((old (classoid-of (find-classoid name)))
+ (new (classoid-of new-value)))
+ (unless (eq old new)
+ (warn "changing meta-class of ~S from ~S to ~S"
+ name (classoid-name old) (classoid-name new)))))
+ (:primitive
+ (error "illegal to redefine standard type ~S" name))
+ (:defined
+ (warn "redefining DEFTYPE type to be a class: ~S" name)
+ (setf (info :type :expander name) nil)))
- (remhash name *forward-referenced-layouts*)
- (%note-type-defined name)
- (setf (info :type :kind name) :instance)
- (setf (classoid-cell-classoid (find-classoid-cell name)) new-value)
- (unless (eq (info :type :compiler-layout name)
- (classoid-layout new-value))
- (setf (info :type :compiler-layout name) (classoid-layout new-value)))
+ (remhash name *forward-referenced-layouts*)
+ (%note-type-defined name)
+ (setf (info :type :kind name) :instance)
+ (setf (classoid-cell-classoid (find-classoid-cell name)) new-value)
+ (unless (eq (info :type :compiler-layout name)
+ (classoid-layout new-value))
+ (setf (info :type :compiler-layout name) (classoid-layout new-value)))))
new-value)
) ; EVAL-WHEN
-
+
;;; Called when we are about to define NAME as a class meeting some
;;; predicate (such as a meta-class type test.) The first result is
;;; always of the desired class. The second result is any existing
(defun check-wrapper-validity (instance)
(let* ((owrapper (wrapper-of instance))
(state (layout-invalid owrapper)))
- (if (null state)
- owrapper
- (ecase (car state)
- (:flush
- (flush-cache-trap owrapper (cadr state) instance))
- (:obsolete
- (obsolete-instance-trap owrapper (cadr state) instance))))))
+ (aver (not (eq state :uninitialized)))
+ (etypecase state
+ (null owrapper)
+ ;; FIXME: I can't help thinking that, while this does cure the
+ ;; symptoms observed from some class redefinitions, this isn't
+ ;; the place to be doing this flushing. Nevertheless... --
+ ;; CSR, 2003-05-31
+ ;;
+ ;; CMUCL comment:
+ ;; We assume in this case, that the :INVALID is from a
+ ;; previous call to REGISTER-LAYOUT for a superclass of
+ ;; INSTANCE's class. See also the comment above
+ ;; FORCE-CACHE-FLUSHES. Paul Dietz has test cases for this.
+ ((member t)
+ (let ((class (class-of instance)))
+ (force-cache-flushes class)
+ (class-wrapper class)))
+ (cons
+ (ecase (car state)
+ (:flush
+ (flush-cache-trap owrapper (cadr state) instance))
+ (:obsolete
+ (obsolete-instance-trap owrapper (cadr state) instance)))))))
(declaim (inline check-obsolete-instance))
(defun check-obsolete-instance (instance)
projects / sbcl.git / commitdiff