0.pre7.54:

[sbcl.git] / src / compiler / srctran.lisp

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 9df0d78..c736fe1 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -43,7 +43,7 @@
 (deftransform complement ((fun) * * :node node :when :both)
   "open code"
   (multiple-value-bind (min max)
-      (function-type-nargs (continuation-type fun))
+      (fun-type-nargs (continuation-type fun))
     (cond
      ((and min (eql min max))
       (let ((dums (make-gensym-list min)))
@@ -62,7 +62,7 @@
 
 ;;; Translate CxR into CAR/CDR combos.
 (defun source-transform-cxr (form)
-  (if (or (byte-compiling) (/= (length form) 2))
+  (if (/= (length form) 2)
       (values nil t)
       (let ((name (symbol-name (car form))))
        (do ((i (- (length name) 2) (1- i))
@@ -3307,21 +3307,23 @@
                   '(eql nil)
                   `(cons (eql ,(car list)) ,(consify (rest list)))))
             (get-element-type (a)
-              (let ((element-type (type-specifier
-                                   (array-type-specialized-element-type a))))
-                (cond ((symbolp element-type)
+              (let ((element-type
+                    (type-specifier (array-type-specialized-element-type a))))
+                (cond ((eq element-type '*)
+                       (specifier-type 'type-specifier))
+                     ((symbolp element-type)
                        (make-member-type :members (list element-type)))
                       ((consp element-type)
                        (specifier-type (consify element-type)))
                       (t
                        (error "can't understand type ~S~%" element-type))))))
       (cond ((array-type-p array-type)
-            (get-element-type array-type))
-           ((union-type-p array-type)             
+            (get-element-type array-type))
+           ((union-type-p array-type)             
              (apply #'type-union
                     (mapcar #'get-element-type (union-type-types array-type))))
-           (t
-            *universal-type*)))))
+           (t
+            *universal-type*)))))
 \f
 ;;;; debuggers' little helpers