From 95816dfe1bac897f06fcd8c7b2a4579d76f841d0 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 21 Mar 2001 01:12:20 +0000 Subject: [PATCH] 0.6.11.20: preparing to attack bug 89.. ..allowed TYPE-INTERSECTION2, and its type methods, to return INTERSECTION-TYPE values ..rewrote SIMPLIFIED-COMPOUND-TYPES so that it handles COMPOUND-TYPE values returned from its SIMPLIFY2 --- src/code/late-type.lisp | 42 ++++++++++++++++++++++++++++++++---------- version.lisp-expr | 2 +- 2 files changed, 33 insertions(+), 11 deletions(-) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index ecf460a..98943af 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -778,20 +778,43 @@ ;;; shared logic for unions and intersections: Stuff TYPE into the ;;; vector TYPES, finding pairs of types which can be simplified by -;;; SIMPLIFY2 and replacing them by their simplified forms. -(defun accumulate-compound-type (type types simplify2) +;;; SIMPLIFY2 (TYPE-UNION2 or TYPE-INTERSECTION2) and replacing them +;;; by their simplified forms. +(defun accumulate1-compound-type (type types %compound-type-p simplify2) (declare (type ctype type)) (declare (type (vector ctype) types)) (declare (type function simplify2)) + ;; Any input object satisfying %COMPOUND-TYPE-P should've been + ;; broken into components before it reached us. + (assert (not (funcall %compound-type-p type))) (dotimes (i (length types) (vector-push-extend type types)) (let ((simplified2 (funcall simplify2 type (aref types i)))) (when simplified2 ;; Discard the old (AREF TYPES I). (setf (aref types i) (vector-pop types)) - ;; Add the new SIMPLIFIED2 to TYPES, by tail recursing. + ;; Merge the new SIMPLIFIED2 into TYPES, by tail recursing. + ;; (Note that the tail recursion is indirect: we go through + ;; ACCUMULATE, not ACCUMULATE1, so that if SIMPLIFIED2 is + ;; handled properly if it satisfies %COMPOUND-TYPE-P.) (return (accumulate-compound-type simplified2 types + %compound-type-p simplify2))))) + ;; Voila. + (values)) + +;;; shared logic for unions and intersections: Use +;;; ACCUMULATE1-COMPOUND-TYPE to merge TYPE into TYPES, either +;;; all in one step or, if %COMPOUND-TYPE-P is satisfied, +;;; component by component. +(defun accumulate-compound-type (type types %compound-type-p simplify2) + (declare (type function %compound-type-p simplify2)) + (flet ((accumulate1 (x) + (accumulate1-compound-type x types %compound-type-p simplify2))) + (declare (inline accumulate1)) + (if (funcall %compound-type-p type) + (map nil #'accumulate1 (compound-type-types type)) + (accumulate1 type))) (values)) ;;; shared logic for unions and intersections: Return a vector of @@ -806,13 +829,11 @@ ;; matter, but helps avoid type ;; warnings at compile time.) :initial-element *empty-type*))) - (flet ((accumulate (type) - (accumulate-compound-type type simplified-types simplify2))) - (declare (inline accumulate)) - (dolist (type input-types) - (if (funcall %compound-type-p type) - (map nil #'accumulate (compound-type-types type)) - (accumulate type)))) + (dolist (input-type input-types) + (accumulate-compound-type input-type + simplified-types + %compound-type-p + simplify2)) simplified-types)) ;;; shared logic for unions and intersections: Make a COMPOUND-TYPE @@ -843,6 +864,7 @@ (let ((simplified-types (simplified-compound-types input-types #'intersection-type-p #'type-intersection2))) + (declare (type (vector ctype) simplified-types)) ;; We want to have a canonical representation of types (or failing ;; that, punt to HAIRY-TYPE). Canonical representation would have ;; intersections inside unions but not vice versa, since you can diff --git a/version.lisp-expr b/version.lisp-expr index 834fe70..fd616d6 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.11.19" +"0.6.11.20" -- 1.7.10.4