projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
format: ~R should check a type only if base is not supplied.
[sbcl.git]
/
src
/
compiler
/
ir1opt.lisp
diff --git
a/src/compiler/ir1opt.lisp
b/src/compiler/ir1opt.lisp
index
8a4d87e
..
dc6769b
100644
(file)
--- a/
src/compiler/ir1opt.lisp
+++ b/
src/compiler/ir1opt.lisp
@@
-166,7
+166,14
@@
:specialized-element-type (array-type-specialized-element-type type))
;; Simple arrays cannot change at all.
type))
:specialized-element-type (array-type-specialized-element-type type))
;; Simple arrays cannot change at all.
type))
+ ((union-type-p type)
+ ;; Conservative union type is an union of conservative types.
+ (let ((res *empty-type*))
+ (dolist (part (union-type-types type) res)
+ (setf res (type-union res (conservative-type part))))))
(t
(t
+ ;; Catch-all.
+ ;;
;; If the type contains some CONS types, the conservative type contains all
;; of them.
(when (types-equal-or-intersect type (specifier-type 'cons))
;; If the type contains some CONS types, the conservative type contains all
;; of them.
(when (types-equal-or-intersect type (specifier-type 'cons))
@@
-1304,7
+1311,7
@@
'(optimize
(preserve-single-use-debug-variables 0))
(lexenv-policy
'(optimize
(preserve-single-use-debug-variables 0))
(lexenv-policy
- (combination-lexenv call)))))
+ (combination-lexenv call)))))
(with-ir1-environment-from-node call
(with-component-last-block (*current-component*
(block-next (node-block call)))
(with-ir1-environment-from-node call
(with-component-last-block (*current-component*
(block-next (node-block call)))
@@
-1715,9
+1722,7
@@
leaf var)))
t)))))
((and (null (rest (leaf-refs var)))
leaf var)))
t)))))
((and (null (rest (leaf-refs var)))
- ;; Don't substitute single-ref variables on high-debug /
- ;; low speed, to improve the debugging experience.
- (policy call (< preserve-single-use-debug-variables 3))
+ (not (preserve-single-use-debug-var-p call var))
(substitute-single-use-lvar arg var)))
(t
(propagate-to-refs var (lvar-type arg))))))
(substitute-single-use-lvar arg var)))
(t
(propagate-to-refs var (lvar-type arg))))))