Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv3424/src/code
Modified Files:
early-type.lisp late-type.lisp
Log Message:
0.7.10.3:
Fix bug: (FUNCTION (&REST T)) = (FUNCTION *).
Index: early-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-type.lisp,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- early-type.lisp 11 Nov 2002 08:37:02 -0000 1.26
+++ early-type.lisp 28 Nov 2002 04:10:22 -0000 1.27
@@ -364,6 +364,12 @@
(error "VALUES type illegal in this context:~% ~S" x))
res))
+(defun single-value-specifier-type (x)
+ (let ((res (specifier-type x)))
+ (if (eq res *wild-type*)
+ *universal-type*
+ res)))
+
;;; Similar to MACROEXPAND, but expands DEFTYPEs. We don't bother
;;; returning a second value.
(defun type-expand (form)
Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- late-type.lisp 24 Nov 2002 06:08:39 -0000 1.63
+++ late-type.lisp 28 Nov 2002 04:10:23 -0000 1.64
@@ -241,7 +241,13 @@
(3and (values-subtypep (fun-type-returns type1)
(fun-type-returns type2))
(cond ((fun-type-wild-args type2) (values t t))
- ((fun-type-wild-args type1) (values nil t))
+ ((fun-type-wild-args type1)
+ (cond ((fun-type-keyp type2) (values nil nil))
+ ((not (fun-type-rest type2)) (values nil t))
+ ((not (null (fun-type-required type2))) (values nil t))
+ (t (3and (type= *universal-type* (fun-type-rest type2))
+ (every/type #'type= *universal-type*
+ (fun-type-optional type2))))))
((not (and (fun-type-simple-p type1)
(fun-type-simple-p type2)))
(values nil nil))
@@ -298,9 +304,12 @@
(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))
- (setf (args-type-rest result) (if restp (specifier-type rest) nil))
+ (setf (args-type-required result)
+ (mapcar #'single-value-specifier-type required))
+ (setf (args-type-optional result)
+ (mapcar #'single-value-specifier-type optional))
+ (setf (args-type-rest result)
+ (if restp (single-value-specifier-type rest) nil))
(setf (args-type-keyp result) keyp)
(collect ((key-info))
(dolist (key keys)
@@ -311,7 +320,7 @@
(error "~@<repeated keyword ~S in lambda list: ~2I~_~S~:>"
kwd lambda-list))
(key-info (make-key-info :name kwd
- :type (specifier-type (second key))))))
+ :type (single-value-specifier-type (second key))))))
(setf (args-type-keywords result) (key-info)))
(setf (args-type-allowp result) allowp)
(values)))
@@ -445,7 +454,7 @@
:initial-element rest2)))
exact)))
-;;; If Type isn't a values type, then make it into one:
+;;; If TYPE isn't a values type, then make it into one:
;;; <type> ==> (values type &rest t)
(defun coerce-to-values (type)
(declare (type ctype type))
|