From 0fc50d64dd4e0a480af51b12c0c1ffd4d835d576 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 17 Dec 2011 01:13:20 +0100 Subject: [PATCH] More efficient expansion of TYPE with interval types --- src/cmp/cmpopt.lsp | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index 77525b27c..0cfe7a2b5 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -130,16 +130,21 @@ ;; (INTEGER * *), etc ((member first '(INTEGER RATIONAL FLOAT REAL SINGLE-FLOAT DOUBLE-FLOAT #+long-float LONG-FLOAT)) - (let ((var (gensym))) + (let ((var1 (gensym)) + (var2 (gensym))) ;; Small optimization: it is easier to check for fixnum ;; than for integer. Use it when possible. (when (and (eq first 'integer) (subtypep type 'fixnum)) (setf first 'fixnum)) - `(LET ((,var ,object)) - (declare (:read-only ,var)) - (AND (TYPEP ,var ',first) - ,@(expand-in-interval-p `(the ,first ,var) rest))))) + `(LET ((,var1 ,object) + (,var2 ,(coerce 0 first))) + (declare (:read-only ,var1) + (type ,first ,var2)) + (AND (TYPEP ,var1 ',first) + (locally (declare (optimize (speed 3) (safety 0) (space 0))) + (setf ,var2 (the ,first ,var1)) + (AND ,@(expand-in-interval-p var2 rest))))))) ;; ;; (SATISFIES predicate) ((and (eq first 'SATISFIES)