projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.43.46: Simplify some type tests to EQL comparisons
[sbcl.git]
/
src
/
compiler
/
typetran.lisp
diff --git
a/src/compiler/typetran.lisp
b/src/compiler/typetran.lisp
index
c1f818d
..
4f1fa05
100644
(file)
--- a/
src/compiler/typetran.lisp
+++ b/
src/compiler/typetran.lisp
@@
-81,7
+81,14
@@
((eq type *empty-type*)
nil)
(t
((eq type *empty-type*)
nil)
(t
- (give-up-ir1-transform)))))
+ (let ((intersect (type-intersection2 type otype)))
+ (unless intersect
+ (give-up-ir1-transform))
+ (multiple-value-bind (constantp value)
+ (type-singleton-p intersect)
+ (if constantp
+ `(eql object ',value)
+ (give-up-ir1-transform))))))))
;;; Flush %TYPEP tests whose result is known at compile time.
(deftransform %typep ((object type))
;;; Flush %TYPEP tests whose result is known at compile time.
(deftransform %typep ((object type))
@@
-554,6
+561,9
@@
(or (when (not ctype)
(compiler-warn "illegal type specifier for TYPEP: ~S" type)
(return-from source-transform-typep (values nil t)))
(or (when (not ctype)
(compiler-warn "illegal type specifier for TYPEP: ~S" type)
(return-from source-transform-typep (values nil t)))
+ (multiple-value-bind (constantp value) (type-singleton-p ctype)
+ (and constantp
+ `(eql ,object ',value)))
(let ((pred (cdr (assoc ctype *backend-type-predicates*
:test #'type=))))
(when pred `(,pred ,object)))
(let ((pred (cdr (assoc ctype *backend-type-predicates*
:test #'type=))))
(when pred `(,pred ,object)))