0.7.7.36:

[sbcl.git] / src / code / late-type.lisp

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 8a4e03b..a28eca6 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -250,9 +250,10 @@
 ;;; used for both FUNCTION and VALUES types.
 (declaim (ftype (function (list args-type) (values)) parse-args-types))
 (defun parse-args-types (lambda-list result)
-  (multiple-value-bind (required optional restp rest keyp keys allowp aux)
-      (parse-lambda-list lambda-list)
-    (when aux
+  (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux)
+      (parse-lambda-list-like-thing lambda-list)
+    (declare (ignore aux)) ; since we require AUXP=NIL
+    (when auxp
       (error "&AUX in a FUNCTION or VALUES type: ~S." lambda-list))
     (setf (args-type-required result) (mapcar #'specifier-type required))
     (setf (args-type-optional result) (mapcar #'specifier-type optional))
@@ -1007,8 +1008,9 @@
 \f
 ;;;; hairy and unknown types
 
-(!define-type-method (hairy :unparse) (x) (hairy-type-specifier x))
-
+(!define-type-method (hairy :unparse) (x)
+  (hairy-type-specifier x))
+    
 (!define-type-method (hairy :simple-subtypep) (type1 type2)
   (let ((hairy-spec1 (hairy-type-specifier type1))
        (hairy-spec2 (hairy-type-specifier type2)))
@@ -1351,7 +1353,7 @@
          (t
           (values nil t)))))
 
-(!define-superclasses number ((generic-number)) !cold-init-forms)
+(!define-superclasses number ((number)) !cold-init-forms)
 
 ;;; If the high bound of LOW is adjacent to the low bound of HIGH,
 ;;; then return true, otherwise NIL.
@@ -2017,9 +2019,10 @@
 
 (!define-type-method (member :unparse) (type)
   (let ((members (member-type-members type)))
-    (if (equal members '(nil))
-       'null
-       `(member ,@members))))
+    (cond
+      ((equal members '(nil)) 'null)
+      ((type= type (specifier-type 'standard-char)) 'standard-char)
+      (t `(member ,@members)))))
 
 (!define-type-method (member :simple-subtypep) (type1 type2)
   (values (subsetp (member-type-members type1) (member-type-members type2))
@@ -2172,13 +2175,17 @@
 
 (!define-type-class union)
 
-;;; The LIST type has a special name. Other union types just get
-;;; mechanically unparsed.
+;;; The LIST, FLOAT and REAL types have special names.  Other union
+;;; types just get mechanically unparsed.
 (!define-type-method (union :unparse) (type)
   (declare (type ctype type))
-  (if (type= type (specifier-type 'list))
-      'list
-      `(or ,@(mapcar #'type-specifier (union-type-types type)))))
+  (cond
+    ((type= type (specifier-type 'list)) 'list)
+    ((type= type (specifier-type 'float)) 'float)
+    ((type= type (specifier-type 'real)) 'real)
+    ((type= type (specifier-type 'sequence)) 'sequence)
+    ((type= type (specifier-type 'string-stream)) 'string-stream)
+    (t `(or ,@(mapcar #'type-specifier (union-type-types type))))))
 
 ;;; Two union types are equal if they are each subtypes of each
 ;;; other. We need to be this clever because our complex subtypep