From 3aff5655417da74a19ce576f55b2cb6999cda6c5 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 10 Nov 2000 20:21:09 +0000 Subject: [PATCH] 0.6.8.14: deleted MNA's tweaked version of DTC's compound CONS type --- package-data-list.lisp-expr | 6 ----- src/code/class.lisp | 3 --- src/code/early-type.lisp | 31 +++++----------------- src/code/late-type.lisp | 62 ------------------------------------------- src/code/target-type.lisp | 20 +++++--------- src/code/typep.lisp | 6 ----- src/compiler/checkgen.lisp | 8 ------ src/compiler/srctran.lisp | 20 -------------- src/compiler/typetran.lisp | 28 ------------------- version.lisp-expr | 2 +- 10 files changed, 14 insertions(+), 172 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index cbbaa3d..af3defe 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -921,9 +921,6 @@ is a good idea, but see SB-SYS for blurring of boundaries." "COMPLEX-RATIONAL-P" "COMPLEX-SINGLE-FLOAT-P" "COMPLEX-VECTOR-P" "CONSED-SEQUENCE" "CONSTANT" "CONSTANT-TYPE" "CONSTANT-TYPE-P" "CONSTANT-TYPE-TYPE" - ;; MNA: cons compound-type patch - ;; FIXIT: all commented out - ; "CONS-TYPE" "CONS-TYPE-CAR-TYPE" "CONS-TYPE-CDR-TYPE" "CONS-TYPE-P" "CONTAINING-INTEGER-TYPE" "CONTROL-STACK-POINTER-SAP" "COPY-FROM-SYSTEM-AREA" "COPY-NUMERIC-TYPE" "COPY-TO-SYSTEM-AREA" @@ -976,9 +973,6 @@ is a good idea, but see SB-SYS for blurring of boundaries." "LRA" "LRA-CODE-HEADER" "LRA-P" "MAKE-ALIEN-TYPE-TYPE" "MAKE-ARGS-TYPE" "MAKE-ARRAY-HEADER" "MAKE-ARRAY-TYPE" "MAKE-DOUBLE-FLOAT" - ;; MNA: cons compound-type patch - ;; FIXIT: all commented out - ; "MAKE-CONS-TYPE" "MAKE-FUNCTION-TYPE" "MAKE-KEY-INFO" "MAKE-LISP-OBJ" "MAKE-LONG-FLOAT" "MAKE-MEMBER-TYPE" "MAKE-NAMED-TYPE" diff --git a/src/code/class.lisp b/src/code/class.lisp index b296f48..bd6d361 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1052,9 +1052,6 @@ :inherits (sequence mutable-sequence mutable-collection generic-sequence collection)) (cons - ;; MNA: cons compound-type patch - ;; FIXIT :all commented out - ; :translation cons :codes (#.sb!vm:list-pointer-type) :inherits (list sequence mutable-sequence mutable-collection diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 480a778..db84f2d 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -175,9 +175,9 @@ ;; FIXME: I'm bewildered by FOO-P names for things not intended to ;; interpreted as truth values. Perhaps rename this COMPLEXNESS? (complexp :real :type (member :real :complex nil)) - ;; The upper and lower bounds on the value. If null, there is no bound. If - ;; a list of a number, the bound is exclusive. Integer types never have - ;; exclusive bounds. + ;; The upper and lower bounds on the value, or NIL if there is no + ;; bound. If a list of a number, the bound is exclusive. Integer + ;; types never have exclusive bounds. (low nil :type (or number cons null)) (high nil :type (or number cons null))) @@ -214,7 +214,7 @@ (:constructor %make-union-type (enumerable types))) ;; The types in the union. (types nil :type list)) - + ;;; Note that the type Name has been (re)defined, updating the ;;; undefined warnings and VALUES-SPECIFIER-TYPE cache. (defun %note-type-defined (name) @@ -223,29 +223,10 @@ (when (boundp 'sb!kernel::*values-specifier-type-cache-vector*) (values-specifier-type-cache-clear)) (values)) - - -;;; MNA: cons compound-type patch -;;; FIXIT: all commented out -;;;; Cons types: - -;;; The Cons-Type is used to represent cons types. -;;; -;; (defstruct (cons-type (:include ctype -;; (:class-info (type-class-or-lose 'cons))) -;; (:print-function %print-type)) -;; ;; -;; ;; The car element type. -;; (car-type *wild-type* :type ctype) -;; ;; -;; ;; The cdr element type. -;; (cdr-type *wild-type* :type ctype)) - -;; (define-type-class cons) - -;;;; KLUDGE: not clear this really belongs here, but where? ;;; Is X a fixnum in the target Lisp? +;;; +;;; KLUDGE: not clear this really belongs in early-type.lisp, but where? (defun target-fixnump (x) (and (integerp x) (<= sb!vm:*target-most-negative-fixnum* diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 1e848c6..863f248 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -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. ;;; diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index 084fe99..1e24030 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -29,13 +29,14 @@ "Return T iff OBJECT is of type TYPE." (%typep object type)) -;;; If Type is a type that we can do a compile-time test on, then return the -;;; whether the object is of that type as the first value and second value -;;; true. Otherwise return NIL, NIL. +;;; If TYPE is a type that we can do a compile-time test on, then +;;; return whether the object is of that type as the first value and +;;; second value true. Otherwise return NIL, NIL. ;;; -;;; We give up on unknown types and pick off FUNCTION and UNION types. For -;;; structure types, we require that the type be defined in both the current -;;; and compiler environments, and that the INCLUDES be the same. +;;; We give up on unknown types and pick off FUNCTION and UNION types. +;;; For structure types, we require that the type be defined in both +;;; the current and compiler environments, and that the INCLUDES be +;;; the same. (defun ctypep (obj type) (declare (type ctype type)) (etypecase type @@ -43,9 +44,6 @@ named-type member-type array-type - ;; MNA: cons compound-type patch - ;; FIXIT: all commented out - ; cons-type sb!xc:built-in-class) (values (%typep obj type) t)) (sb!xc:class @@ -203,10 +201,6 @@ :complexp (not (typep x 'simple-array)) :element-type etype :specialized-element-type etype))) - ;; MNA: cons compound-type patch - ;; FIXIT: all commented - ; (cons - ; (make-cons-type)) (t (sb!xc:class-of x)))) diff --git a/src/code/typep.lisp b/src/code/typep.lisp index 2c461ed..b82f92c 100644 --- a/src/code/typep.lisp +++ b/src/code/typep.lisp @@ -114,12 +114,6 @@ (dolist (type (union-type-types type)) (when (%%typep object type) (return t)))) - ;; MNA: cons compound-type patch - ;; FIXIT: all commented out -; (cons-type -; (and (consp object) -; (%%typep (car object) (cons-type-car-type type)) -; (%%typep (cdr object) (cons-type-cdr-type type)))) (unknown-type ;; dunno how to do this ANSIly -- WHN 19990413 #+sb-xc-host (error "stub: %%TYPEP UNKNOWN-TYPE in xcompilation host") diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 8476000..e727624 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -67,14 +67,6 @@ (+ 1 (if (numeric-type-low type) 1 0) (if (numeric-type-high type) 1 0)))) - ;; MNA: cons compound-type patch - ;; FIXIT: all commented out -; (cons-type -; (+ (type-test-cost (specifier-type 'cons)) -; (function-cost 'car) -; (type-test-cost (cons-type-car-type type)) -; (function-cost 'cdr) -; (type-test-cost (cons-type-cdr-type type)))) (t (function-cost 'typep))))) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index d8e2ac0..16d6ceb 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -138,26 +138,6 @@ `(cdr ,(frob (1- n)))))) (frob n)))) -;;; MNA: cons compound-type patch -;;; FIXIT: all commented out - -; ;;;; CONS assessor derive type optimizers. - -; (defoptimizer (car derive-type) ((cons)) -; (let ((type (continuation-type cons))) -; (cond ((eq type (specifier-type 'null)) -; (specifier-type 'null)) -; ((cons-type-p type) -; (cons-type-car-type type))))) - -; (defoptimizer (cdr derive-type) ((cons)) -; (let ((type (continuation-type cons))) -; (cond ((eq type (specifier-type 'null)) -; (specifier-type 'null)) -; ((cons-type-p type) -; (cons-type-cdr-type type))))) - - ;;;; arithmetic and numerology (def-source-transform plusp (x) `(> ,x 0)) diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index 1b48fea..b0160e4 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -298,30 +298,6 @@ `(typep ,n-obj ',(type-specifier x))) types))))))) -;;; MNA: cons compound-type patch -;;; FIXIT: all commented out -; ;;; Source-Transform-Cons-Typep -; ;;; -; ;;; If necessary recurse to check the cons type. -; ;;; -; (defun source-transform-cons-typep (object type) -; (let* ((car-type (cons-type-car-type type)) -; (cdr-type (cons-type-cdr-type type))) -; (let ((car-test-p (not (or (type= car-type *wild-type*) -; (type= car-type (specifier-type t))))) -; (cdr-test-p (not (or (type= cdr-type *wild-type*) -; (type= cdr-type (specifier-type t)))))) -; (if (and (not car-test-p) (not cdr-test-p)) -; `(consp ,object) -; (once-only ((n-obj object)) -; `(and (consp ,n-obj) -; ,@(if car-test-p -; `((typep (car ,n-obj) -; ',(type-specifier car-type)))) -; ,@(if cdr-test-p -; `((typep (cdr ,n-obj) -; ',(type-specifier cdr-type)))))))))) - ;;; Return the predicate and type from the most specific entry in ;;; *TYPE-PREDICATES* that is a supertype of TYPE. (defun find-supertype-predicate (type) @@ -519,10 +495,6 @@ `(%instance-typep ,object ,spec)) (array-type (source-transform-array-typep object type)) - ;; MNA: cons compound-type patch - ;; FIXIT: all commented -; (cons-type -; (source-transform-cons-typep object type)) (t nil))) `(%typep ,object ,spec))) (values nil t))) diff --git a/version.lisp-expr b/version.lisp-expr index f1e54a7..a1dbea8 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.8.13" +"0.6.8.14" -- 1.7.10.4