From 33a45339444f8418c8c537c43d59fc3d5ea3098b Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 7 Nov 2010 01:18:29 +0000 Subject: [PATCH] 1.0.44.2: don't add pointless TYPEP T constraints Pointless constraints are not only pointless, they also slow things down for no good reason. --- src/compiler/constraint.lisp | 24 +++++++++++++----------- version.lisp-expr | 2 +- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index eb936ba..a32c5a9 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -761,11 +761,11 @@ for var in (lambda-vars fun) and val in (combination-args call) when (and val (lambda-var-constraints var)) - do (let* ((type (lvar-type val)) - (con (find-or-create-constraint 'typep var type - nil))) - (conset-adjoin con gen)) - (maybe-add-eql-var-var-constraint var val gen))))) + do (let ((type (lvar-type val))) + (unless (eq type *universal-type*) + (let ((con (find-or-create-constraint 'typep var type nil))) + (conset-adjoin con gen)))) + (maybe-add-eql-var-var-constraint var val gen))))) (ref (when (ok-ref-lambda-var node) (maybe-add-eql-var-lvar-constraint node gen) @@ -778,17 +778,19 @@ (let ((var (ok-lvar-lambda-var lvar gen))) (when var (let ((atype (single-value-type (cast-derived-type node)))) ;FIXME - (do-eql-vars (var (var gen)) - (let ((con (find-or-create-constraint 'typep var atype nil))) - (conset-adjoin con gen)))))))) + (unless (eq atype *universal-type*) + (do-eql-vars (var (var gen)) + (let ((con (find-or-create-constraint 'typep var atype nil))) + (conset-adjoin con gen))))))))) (cset (binding* ((var (set-var node)) (nil (lambda-var-p var) :exit-if-null) (cons (lambda-var-constraints var) :exit-if-null)) (conset-difference gen cons) - (let* ((type (single-value-type (node-derived-type node))) - (con (find-or-create-constraint 'typep var type nil))) - (conset-adjoin con gen)) + (let ((type (single-value-type (node-derived-type node)))) + (unless (eq type *universal-type*) + (let ((con (find-or-create-constraint 'typep var type nil))) + (conset-adjoin con gen)))) (maybe-add-eql-var-var-constraint var (set-value node) gen))))) gen) diff --git a/version.lisp-expr b/version.lisp-expr index 3707069..1fe853e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.44.1" +"1.0.44.2" -- 1.7.10.4