X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fconstraint.lisp;h=5a4c62746e476f378991246cf270a72af6ce0885;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=ba008cd267a4e3e5b195a1e10dad1c3fdc7e46c3;hpb=0223a229f6fd1b4cfc809e30e35361df99fb2340;p=sbcl.git

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index ba008cd..5a4c627 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -155,9 +155,10 @@
 
   (defmacro do-conset-elements ((constraint conset &optional result) &body body)
     (with-unique-names (vector index start end
-                               ignore constraint-universe-end)
+                               #-sb-xc-host ignore
+                               #-sb-xc-host constraint-universe-end)
       (let* ((constraint-universe #+sb-xc-host '*constraint-universe*
-                                  #-sb-xc-host (gensym))
+                                  #-sb-xc-host (sb!xc:gensym "UNIVERSE"))
              (with-array-data
                 #+sb-xc-host '(progn)
                 #-sb-xc-host `(with-array-data
@@ -202,7 +203,7 @@
       ret))
 
   (defun %conset-grow (conset new-size)
-    (declare (index new-size))
+    (declare (type index new-size))
     (setf (conset-vector conset)
           (replace (the simple-bit-vector
                      (make-array
@@ -214,7 +215,7 @@
 
   (declaim (inline conset-grow))
   (defun conset-grow (conset new-size)
-    (declare (index new-size))
+    (declare (type index new-size))
     (when (< (length (conset-vector conset)) new-size)
       (%conset-grow conset new-size))
     (values))
@@ -356,7 +357,7 @@
       (let ((new (make-constraint (length *constraint-universe*)
                                   kind x y not-p)))
         (vector-push-extend new *constraint-universe*
-                            (* 2 (length *constraint-universe*)))
+                            (1+ (length *constraint-universe*)))
         (conset-adjoin new (lambda-var-constraints x))
         (when (lambda-var-p y)
           (conset-adjoin new (lambda-var-constraints y)))
@@ -467,7 +468,8 @@
                              (ok-lvar-lambda-var (first args) constraints)
                              (if (ctype-p val)
                                  val
-                                 (specifier-type val))
+                                 (let ((*compiler-error-context* use))
+                                   (specifier-type val)))
                              nil)))))
                  ((eq eql)
                   (let* ((arg1 (first args))