X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=da44cd4eee3152cb11ad6a3b781256e80c28b44c;hb=9489abab7f981b8eea2aec8a883f2eb48d4cb138;hp=f7c60500516822cad5cdddab011137dab581ea64;hpb=f1407e424f1063203af07d2e61ceef58515a4797;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index f7c6050..da44cd4 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -150,7 +150,13 @@
   (error "SUBTYPEP is illegal on this type:~%  ~S" (type-specifier type2)))
 
 (!define-type-method (values :unparse) (type)
-  (cons 'values (unparse-args-types type)))
+  (cons 'values
+        (let ((unparsed (unparse-args-types type)))
+          (if (or (values-type-optional type)
+                  (values-type-rest type)
+                  (values-type-allowp type))
+              unparsed
+              (nconc unparsed '(&optional))))))
 
 ;;; Return true if LIST1 and LIST2 have the same elements in the same
 ;;; positions according to TYPE=. We return NIL, NIL if there is an
@@ -287,7 +293,7 @@
   (type= (constant-type-type type1) (constant-type-type type2)))
 
 (!def-type-translator constant-arg (type)
-  (make-constant-type :type (specifier-type type)))
+  (make-constant-type :type (single-value-specifier-type type)))
 
 ;;; Return the lambda-list-like type specification corresponding
 ;;; to an ARGS-TYPE.
@@ -972,10 +978,11 @@
 (defvar *empty-type*)
 (defvar *universal-type*)
 (defvar *universal-fun-type*)
+
 (!cold-init-forms
  (macrolet ((frob (name var)
 	      `(progn
-		 (setq ,var (make-named-type :name ',name))
+                 (setq ,var (make-named-type :name ',name))
 		 (setf (info :type :kind ',name)
 		       #+sb-xc-host :defined #-sb-xc-host :primitive)
 		 (setf (info :type :builtin ',name) ,var))))
@@ -2661,8 +2668,8 @@
 (!define-type-class cons)
 
 (!def-type-translator cons (&optional (car-type-spec '*) (cdr-type-spec '*))
-  (let ((car-type (specifier-type car-type-spec))
-	(cdr-type (specifier-type cdr-type-spec)))
+  (let ((car-type (single-value-specifier-type car-type-spec))
+	(cdr-type (single-value-specifier-type cdr-type-spec)))
     (make-cons-type car-type cdr-type)))
  
 (!define-type-method (cons :unparse) (type)
@@ -2788,14 +2795,18 @@
   (specialize-array-type
    (make-array-type :dimensions (canonical-array-dimensions dimensions)
                     :complexp :maybe
-		    :element-type (specifier-type element-type))))
+		    :element-type (if (eq element-type '*)
+                                      *wild-type*
+                                      (specifier-type element-type)))))
 
 (!def-type-translator simple-array (&optional (element-type '*)
 					      (dimensions '*))
   (specialize-array-type
    (make-array-type :dimensions (canonical-array-dimensions dimensions)
                     :complexp nil
-		    :element-type (specifier-type element-type))))
+		    :element-type (if (eq element-type '*)
+                                      *wild-type*
+                                      (specifier-type element-type)))))
 
 ;;;; utilities shared between cross-compiler and target system