From 7ff14ce5fb7d138d2cd39eb6364e5ae175ac1838 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 28 Aug 2003 12:11:48 +0000 Subject: [PATCH] 0.8.3.9: Faster compiler! Wheeeeeeeeeeeeeeee! ... use lists rather than adjustable vectors deep in type-intersection/union canonicalization; ... still c. 50% slower than certain other lisp compilers on the all-important "compile sbcl" benchmark. --- NEWS | 3 ++ src/code/late-type.lisp | 108 +++++++++++++++--------------------------------- version.lisp-expr | 2 +- 3 files changed, 38 insertions(+), 75 deletions(-) diff --git a/NEWS b/NEWS index 045eab500..cc907acdb 100644 --- a/NEWS +++ b/NEWS @@ -2014,6 +2014,9 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: * optimization: restored some effective method precomputation in CLOS (turned off by an ANSI fix in sbcl-0.8.3); the amount of precomputation is now tunable. + * optimization: compiler-internal data structure use has been + reviewed, and changes have been made that should improve the + performance of the compiler by about 20%. * bug fix: in some situations compiler did not report usage of generic arithmetic in (SPEED 3) policy. diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index da4f37faf..b2cedaf2c 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -927,65 +927,27 @@ ;;;; These are fully general operations on CTYPEs: they'll always ;;;; return a CTYPE representing the result. -;;; shared logic for unions and intersections: Return a vector of +;;; shared logic for unions and intersections: Return a list of ;;; types representing the same types as INPUT-TYPES, but with ;;; COMPOUND-TYPEs satisfying %COMPOUND-TYPE-P broken up into their ;;; component types, and with any SIMPLY2 simplifications applied. -(declaim (inline simplified-compound-types)) -(defun simplified-compound-types (input-types %compound-type-p simplify2) - (declare (function %compound-type-p simplify2)) - (let ((types (make-array (length input-types) - :fill-pointer 0 - :adjustable t - :element-type 'ctype))) - (labels ((accumulate-compound-type (type) - (if (funcall %compound-type-p type) - (dolist (type (compound-type-types type)) - (accumulate1-compound-type type)) - (accumulate1-compound-type type))) - (accumulate1-compound-type (type) - (declare (type ctype type)) - ;; Any input object satisfying %COMPOUND-TYPE-P should've been - ;; broken into components before it reached us. - (aver (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)) - ;; 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))))))) - (dolist (input-type input-types) - (accumulate-compound-type input-type))) - types)) - -;;; shared logic for unions and intersections: Make a COMPOUND-TYPE -;;; object whose components are the types in TYPES, or skip to special -;;; cases when TYPES is short. -(defun make-probably-compound-type (constructor types enumerable identity) - (declare (type function constructor)) - (declare (type (vector ctype) types)) - (declare (type ctype identity)) - (case (length types) - (0 identity) - (1 (aref types 0)) - (t (funcall constructor - enumerable - ;; FIXME: This should be just (COERCE TYPES 'LIST), but as - ;; of sbcl-0.6.11.17 the COERCE optimizer is really - ;; brain-dead, so that would generate a full call to - ;; SPECIFIER-TYPE at runtime, so we get into bootstrap - ;; problems in cold init because 'LIST is a compound - ;; type, so we need to MAKE-PROBABLY-COMPOUND-TYPE - ;; before we know what 'LIST is. Once the COERCE - ;; optimizer is less brain-dead, we can make this - ;; (COERCE TYPES 'LIST) again. - #+sb-xc-host (coerce types 'list) - #-sb-xc-host (coerce-to-list types))))) - +(macrolet + ((def (name compound-type-p simplify2) + `(defun ,name (types) + (when types + (multiple-value-bind (first rest) + (if (,compound-type-p (car types)) + (values (car (compound-type-types (car types))) + (append (cdr (compound-type-types (car types))) + (cdr types))) + (values (car types) (cdr types))) + (let ((rest (,name rest)) u) + (dolist (r rest (cons first rest)) + (when (setq u (,simplify2 first r)) + (return (,name (nsubstitute u r rest))))))))))) + (def simplify-intersections intersection-type-p type-intersection2) + (def simplify-unions union-type-p type-union2)) + (defun maybe-distribute-one-union (union-type types) (let* ((intersection (apply #'type-intersection types)) (union (mapcar (lambda (x) (type-intersection x intersection)) @@ -1002,10 +964,8 @@ :hash-function (lambda (x) (logand (sxhash x) #xff))) ((input-types equal)) - (let ((simplified-types (simplified-compound-types input-types - #'intersection-type-p - #'type-intersection2))) - (declare (type (vector ctype) simplified-types)) + (let ((simplified-types (simplify-intersections input-types))) + (declare (type list 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 @@ -1014,8 +974,7 @@ ;; to end up with unreasonably huge type expressions. So instead ;; we try to generate a simple type by distributing the union; if ;; the type can't be made simple, we punt to HAIRY-TYPE. - (if (and (> (length simplified-types) 1) - (some #'union-type-p simplified-types)) + (if (and (cdr simplified-types) (some #'union-type-p simplified-types)) (let* ((first-union (find-if #'union-type-p simplified-types)) (other-types (coerce (remove first-union simplified-types) 'list)) @@ -1027,11 +986,12 @@ :specifier `(and ,@(map 'list #'type-specifier simplified-types))))) - (make-probably-compound-type #'%make-intersection-type - simplified-types - (some #'type-enumerable - simplified-types) - *universal-type*)))) + (cond + ((null simplified-types) *universal-type*) + ((null (cdr simplified-types)) (car simplified-types)) + (t (%make-intersection-type + (some #'type-enumerable simplified-types) + simplified-types)))))) (defun type-union (&rest input-types) (%type-union input-types)) @@ -1039,13 +999,13 @@ :hash-function (lambda (x) (logand (sxhash x) #xff))) ((input-types equal)) - (let ((simplified-types (simplified-compound-types input-types - #'union-type-p - #'type-union2))) - (make-probably-compound-type #'make-union-type - simplified-types - (every #'type-enumerable simplified-types) - *empty-type*))) + (let ((simplified-types (simplify-unions input-types))) + (cond + ((null simplified-types) *empty-type*) + ((null (cdr simplified-types)) (car simplified-types)) + (t (make-union-type + (every #'type-enumerable simplified-types) + simplified-types))))) ;;;; built-in types diff --git a/version.lisp-expr b/version.lisp-expr index 28f00e1b1..823b0d5cf 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; with something arbitrary in the fourth field, is used for CVS ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS -"0.8.3.8" +"0.8.3.9" -- 2.11.4.GIT