projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.24.20: misc HPPA & HPUX updates
[sbcl.git]
/
src
/
pcl
/
walk.lisp
diff --git
a/src/pcl/walk.lisp
b/src/pcl/walk.lisp
index
ba16dfa
..
3f6d209
100644
(file)
--- a/
src/pcl/walk.lisp
+++ b/
src/pcl/walk.lisp
@@
-257,6
+257,11
@@
(defun env-declarations (env)
(caddr (env-lock env)))
(defun env-declarations (env)
(caddr (env-lock env)))
+(defun env-var-type (var env)
+ (dolist (decl (env-declarations env) t)
+ (when (and (eq 'type (car decl)) (member var (cddr decl) :test 'eq))
+ (return (cadr decl)))))
+
(defun env-lexical-variables (env)
(cadddr (env-lock env)))
(defun env-lexical-variables (env)
(cadddr (env-lock env)))
@@
-465,12
+470,17
@@
((not (consp newform))
(let ((symmac (car (variable-symbol-macro-p newform env))))
(if symmac
((not (consp newform))
(let ((symmac (car (variable-symbol-macro-p newform env))))
(if symmac
- (let ((newnewform (walk-form-internal (cddr symmac)
- context
- env)))
- (if (eq newnewform (cddr symmac))
- (if *walk-form-expand-macros-p* newnewform newform)
- newnewform))
+ (let* ((newnewform (walk-form-internal (cddr symmac)
+ context
+ env))
+ (resultform
+ (if (eq newnewform (cddr symmac))
+ (if *walk-form-expand-macros-p* newnewform newform)
+ newnewform))
+ (type (env-var-type newform env)))
+ (if (eq t type)
+ resultform
+ `(the ,type ,resultform)))
newform)))
(t
(let* ((fn (car newform))
newform)))
(t
(let* ((fn (car newform))
@@
-633,7
+643,7
@@
,(or (var-lexical-p name env) name)
,.args)
env)
,(or (var-lexical-p name env) name)
,.args)
env)
- (note-declaration declaration env))
+ (note-declaration (sb!c::canonized-decl-spec declaration) env))
(push declaration declarations)))
(recons body
form
(push declaration declarations)))
(recons body
form
@@
-853,7
+863,10
@@
(val (caddr form))
(symmac (car (variable-symbol-macro-p var env))))
(if symmac
(val (caddr form))
(symmac (car (variable-symbol-macro-p var env))))
(if symmac
- (let* ((expanded `(setf ,(cddr symmac) ,val))
+ (let* ((type (env-var-type var env))
+ (expanded (if (eq t type)
+ `(setf ,(cddr symmac) ,val)
+ `(setf ,(cddr symmac) `(the ,type ,val))))
(walked (walk-form-internal expanded context env)))
(if (eq expanded walked)
form
(walked (walk-form-internal expanded context env)))
(if (eq expanded walked)
form