X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Flate-type.lisp;h=863f2487fff50a861c7cd692d3cd57c37670be62;hb=3aff5655417da74a19ce576f55b2cb6999cda6c5;hp=88c91ecccdf4667c96a2c00aa53f7b9f2e406ab9;hpb=95a6db7329b91dd90d165dd4057b9b5098d34aa2;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 88c91ec..863f248 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -364,8 +364,8 @@
 ;;; Return two values:
 ;;; MNA: fix-instance-typep-call patch
 ;;; 1. A list of all the positional (fixed and optional) types.
-;;; 2] The rest type (if any).  If keywords allowed, *universal-type*.
-;;;    If no keywords or rest then the default-type.
+;;; 2. The &REST type (if any). If keywords allowed, *UNIVERSAL-TYPE*.
+;;;    If no keywords or &REST, then the DEFAULT-TYPE.
 (defun values-type-types (type &optional (default-type *empty-type*))
   (declare (type values-type type))
   (values (append (args-type-required type)
@@ -1688,68 +1688,6 @@
 	    (return (make-hairy-type :specifier spec)))
 	  (setq res int))))))
 
-
-;;; MNA: cons compound-type patch
-;;; FIXIT: all commented out
-
-; (define-type-class cons)
- 
-; (def-type-translator cons (&optional car-type cdr-type)
-;   (make-cons-type :car-type (specifier-type car-type)
-;  		  :cdr-type (specifier-type cdr-type)))
- 
-; (define-type-method (cons :unparse) (type)
-;   (let ((car-eltype (type-specifier (cons-type-car-type type)))
-;  	(cdr-eltype (type-specifier (cons-type-cdr-type type))))
-;     (cond ((and (eq car-eltype '*) (eq cdr-eltype '*))
-;  	   'cons)
-;  	  (t
-;  	   `(cons ,car-eltype ,cdr-eltype)))))
- 
-; (define-type-method (cons :simple-=) (type1 type2)
-;   (declare (type cons-type type1 type2))
-;   (and (type= (cons-type-car-type type1) (cons-type-car-type type2))
-;        (type= (cons-type-cdr-type type1) (cons-type-cdr-type type2))))
- 
-; (define-type-method (cons :simple-subtypep) (type1 type2)
-;   (declare (type cons-type type1 type2))
-;   (multiple-value-bind (val-car win-car)
-;       (csubtypep (cons-type-car-type type1) (cons-type-car-type type2))
-;     (multiple-value-bind (val-cdr win-cdr)
-;  	(csubtypep (cons-type-cdr-type type1) (cons-type-cdr-type type2))
-;       (if (and val-car val-cdr)
-;  	  (values t (and win-car win-cdr))
-;         (values nil (or win-car win-cdr))))))
- 
-; ;;; CONS :simple-union method  -- Internal
-; ;;;
-; ;;; Give up if a precise type in not possible, to avoid returning overly
-; ;;; general types.
-; ;;;
-; (define-type-method (cons :simple-union) (type1 type2)
-;   (declare (type cons-type type1 type2))
-;   (let ((car-type1 (cons-type-car-type type1))
-;  	(car-type2 (cons-type-car-type type2))
-;  	(cdr-type1 (cons-type-cdr-type type1))
-;  	(cdr-type2 (cons-type-cdr-type type2)))
-;     (cond ((type= car-type1 car-type2)
-;  	   (make-cons-type :car-type car-type1
-;  			   :cdr-type (type-union cdr-type1 cdr-type2)))
-;  	  ((type= cdr-type1 cdr-type2)
-;  	   (make-cons-type :car-type (type-union cdr-type1 cdr-type2)
-;  			   :cdr-type cdr-type1)))))
- 
-; (define-type-method (cons :simple-intersection) (type1 type2)
-;   (declare (type cons-type type1 type2))
-;   (multiple-value-bind (int-car win-car)
-;       (type-intersection (cons-type-car-type type1) (cons-type-car-type type2))
-;     (multiple-value-bind (int-cdr win-cdr)
-;  	(type-intersection (cons-type-cdr-type type1) (cons-type-cdr-type type2))
-;       (values (make-cons-type :car-type int-car :cdr-type int-cdr)
-;  	      (and win-car win-cdr)))))
-
-
-
 ;;; Return the type that describes all objects that are in X but not
 ;;; in Y. If we can't determine this type, then return NIL.
 ;;;