we end up with a segfault.
bug 367b: Comment out the (DECLAIM (FTYPE ... R367)), and compile
the file. The compiler fails with TYPE-ERROR at compile time.
+
+368: miscompiled OR (perhaps related to bug 367)
+ Trying to relax type declarations to find a workaround for bug 367,
+ it turns out that even when the return type isn't declared (or
+ declared to be T, anyway) the system remains confused about type
+ inference in code similar to that for bug 367:
+ (in-package :cl-user)
+ (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
+ (defstruct e368)
+ (defstruct i368)
+ (defstruct g368
+ (i368s (make-array 0 :fill-pointer t) :type (or (vector i368) null)))
+ (defstruct s368
+ (g368 (error "missing :G368") :type g368 :read-only t))
+ (declaim (ftype (function (fixnum (vector i368) e368) t) r368))
+ (declaim (ftype (function (fixnum (vector e368)) t) h368))
+ (defparameter *h368-was-called-p* nil)
+ (defun nsu (vertices e368)
+ (let ((i368s (g368-i368s (make-g368))))
+ (let ((fuis (r368 0 i368s e368)))
+ (format t "~&FUIS=~S~%" fuis)
+ (or fuis (h368 0 i368s)))))
+ (defun r368 (w x y)
+ (declare (ignore w x y))
+ nil)
+ (defun h368 (w x)
+ (declare (ignore w x))
+ (setf *h368-was-called-p* t)
+ (make-s368 :g368 (make-g368)))
+ (trace r368 h368)
+ (format t "~&calling NSU~%")
+ (let ((nsu (nsu #() (make-e368))))
+ (format t "~&NSU returned ~S~%" nsu)
+ (format t "~&*H368-WAS-CALLED-P*=~S~%" *h368-was-called-p*)
+ (assert (s368-p nsu))
+ (assert *h368-was-called-p*))
+ In sbcl-0.8.18, both ASSERTs fail, and (DISASSEMBLE 'NSU) shows
+ that no call to H368 is compiled.
+
+369: unlike-an-intersection behavior of VALUES-TYPE-INTERSECTION
+ In sbcl-0.8.18.2, the identity $(x \cap y \cap y)=(x \cap y)$
+ does not hold for VALUES-TYPE-INTERSECTION, even for types which
+ can be intersected exactly, so that ASSERTs fail in this test case:
+ (in-package :cl-user)
+ (let ((types (mapcar #'sb-c::values-specifier-type
+ '((values (vector package) &optional)
+ (values (vector package) &rest t)
+ (values (vector hash-table) &rest t)
+ (values (vector hash-table) &optional)
+ (values t &optional)
+ (values t &rest t)
+ (values nil &optional)
+ (values nil &rest t)
+ (values sequence &optional)
+ (values sequence &rest t)
+ (values list &optional)
+ (values list &rest t)))))
+ (dolist (x types)
+ (dolist (y types)
+ (let ((i (sb-c::values-type-intersection x y)))
+ (assert (sb-c::type= i (sb-c::values-type-intersection i x)))
+ (assert (sb-c::type= i (sb-c::values-type-intersection i y)))))))
(def!method print-object ((x ctran) stream)
(print-unreadable-object (x stream :type t :identity t)
- (format stream " #~D" (cont-num x))))
+ (format stream "~D" (cont-num x))))
;;; Linear VARiable. Multiple-value (possibly of unknown number)
;;; temporal storage.
(def!method print-object ((x lvar) stream)
(print-unreadable-object (x stream :type t :identity t)
- (format stream " #~D" (cont-num x))))
+ (format stream "~D" (cont-num x))))
(def!struct (node (:constructor nil)
- (:copier nil))
+ (:copier nil))
;; unique ID for debugging
#!+sb-show (id (new-object-id) :read-only t)
;; True if this node needs to be optimized. This is set to true
(tail-p nil :type boolean))
(def!struct (valued-node (:conc-name node-)
- (:include node)
- (:constructor nil)
- (:copier nil))
+ (:include node)
+ (:constructor nil)
+ (:copier nil))
;; the bottom-up derived type for this node.
(derived-type *wild-type* :type ctype)
;; Lvar, receiving the values, produced by this node. May be NIL if
;;; numbering in the debug-info (though that is relative to the start
;;; of the function.)
(def!struct (cblock (:include sset-element)
- (:constructor make-block (start))
- (:constructor make-block-key)
- (:conc-name block-)
- (:predicate block-p))
+ (:constructor make-block (start))
+ (:constructor make-block-key)
+ (:conc-name block-)
+ (:predicate block-p))
;; a list of all the blocks that are predecessors/successors of this
;; block. In well-formed IR1, most blocks will have one successor.
;; The only exceptions are:
;;; different BLOCK-INFO annotation structures so that code
;;; (specifically control analysis) can be shared.
(def!struct (block-annotation (:constructor nil)
- (:copier nil))
+ (:copier nil))
;; The IR1 block that this block is in the INFO for.
(block (missing-arg) :type cblock)
;; the next and previous block in emission order (not DFO). This
;;; non-local exits. This is effectively an annotation on the
;;; continuation, although it is accessed by searching in the
;;; PHYSENV-NLX-INFO.
-(def!struct (nlx-info (:constructor make-nlx-info
- (cleanup exit &aux (lvar (node-lvar exit))))
- (:make-load-form-fun ignore-it))
+(def!struct (nlx-info
+ (:constructor make-nlx-info (cleanup
+ exit
+ &aux (lvar (node-lvar exit))))
+ (:make-load-form-fun ignore-it))
;; the cleanup associated with this exit. In a catch or
;; unwind-protect, this is the :CATCH or :UNWIND-PROTECT cleanup,
;; and not the cleanup for the escape block. The CLEANUP-KIND of
;;; initially (and forever) NIL, since REFs don't receive any values
;;; and don't have any IR1 optimizer.
(def!struct (ref (:include valued-node (reoptimize nil))
- (:constructor make-ref
- (leaf
- &aux (leaf-type (leaf-type leaf))
- (derived-type
- (make-single-value-type leaf-type))))
- (:copier nil))
+ (:constructor make-ref
+ (leaf
+ &aux (leaf-type (leaf-type leaf))
+ (derived-type
+ (make-single-value-type leaf-type))))
+ (:copier nil))
;; The leaf referenced.
(leaf nil :type leaf))
(defprinter (ref :identity t)
;;; Naturally, the IF node always appears at the end of a block.
(def!struct (cif (:include node)
- (:conc-name if-)
- (:predicate if-p)
- (:constructor make-if)
- (:copier copy-if))
+ (:conc-name if-)
+ (:predicate if-p)
+ (:constructor make-if)
+ (:copier copy-if))
;; LVAR for the predicate
(test (missing-arg) :type lvar)
;; the blocks that we execute next in true and false case,
(def!struct (cset (:include valued-node
(derived-type (make-single-value-type
*universal-type*)))
- (:conc-name set-)
- (:predicate set-p)
- (:constructor make-set)
- (:copier copy-set))
+ (:conc-name set-)
+ (:predicate set-p)
+ (:constructor make-set)
+ (:copier copy-set))
;; descriptor for the variable set
(var (missing-arg) :type basic-var)
;; LVAR for the value form
;;; node appears at the end of its block and the body of the called
;;; function appears as the successor; the NODE-LVAR is null.
(def!struct (basic-combination (:include valued-node)
- (:constructor nil)
- (:copier nil))
+ (:constructor nil)
+ (:copier nil))
;; LVAR for the function
(fun (missing-arg) :type lvar)
;; list of LVARs for the args. In a local call, an argument lvar may
;;; including FUNCALL. This is distinct from BASIC-COMBINATION so that
;;; an MV-COMBINATION isn't COMBINATION-P.
(def!struct (combination (:include basic-combination)
- (:constructor make-combination (fun))
- (:copier nil)))
+ (:constructor make-combination (fun))
+ (:copier nil)))
(defprinter (combination :identity t)
#!+sb-show id
(fun :prin1 (lvar-uses fun))
;;; FUNCALL. This is used to implement all the multiple-value
;;; receiving forms.
(def!struct (mv-combination (:include basic-combination)
- (:constructor make-mv-combination (fun))
- (:copier nil)))
+ (:constructor make-mv-combination (fun))
+ (:copier nil)))
(defprinter (mv-combination)
(fun :prin1 (lvar-uses fun))
(args :prin1 (mapcar #'lvar-uses args)))
;;; The BIND node marks the beginning of a lambda body and represents
;;; the creation and initialization of the variables.
(def!struct (bind (:include node)
- (:copier nil))
+ (:copier nil))
;; the lambda we are binding variables for. Null when we are
;; creating the LAMBDA during IR1 translation.
(lambda nil :type (or clambda null)))
;;; is also where we stick information used for TAIL-SET type
;;; inference.
(def!struct (creturn (:include node)
- (:conc-name return-)
- (:predicate return-p)
- (:constructor make-return)
- (:copier copy-return))
+ (:conc-name return-)
+ (:predicate return-p)
+ (:constructor make-return)
+ (:copier copy-return))
;; the lambda we are returning from. Null temporarily during
;; ir1tran.
(lambda nil :type (or clambda null))
;;; TYPE-TO-CHECK is performed and then the VALUE is declared to be of
;;; type ASSERTED-TYPE.
(def!struct (cast (:include valued-node)
- (:constructor %make-cast))
+ (:constructor %make-cast))
(asserted-type (missing-arg) :type ctype)
(type-to-check (missing-arg) :type ctype)
;; an indication of what we have proven about how this type
;;; lexical exit. It is the mess-up node for the corresponding :ENTRY
;;; cleanup.
(def!struct (entry (:include node)
- (:copier nil))
+ (:copier nil))
;; All of the EXIT nodes for potential non-local exits to this point.
(exits nil :type list)
;; The cleanup for this entry. NULL only temporarily.
;;; lvar is the exit node's LVAR; physenv analysis also makes it the
;;; lvar of %NLX-ENTRY call.
(def!struct (exit (:include valued-node)
- (:copier nil))
+ (:copier nil))
;; the ENTRY node that this is an exit for. If null, this is a
;; degenerate exit. A degenerate exit is used to "fill" an empty
;; block (which isn't allowed in IR1.) In a degenerate exit, Value
projects / sbcl.git / commitdiff