(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)))
(push (list thing :lexical-var) (cadddr (env-lock env))))
(defun var-lexical-p (var env)
- (let ((entry (member var (env-lexical-variables env) :key #'car)))
+ (let ((entry (member var (env-lexical-variables env) :key #'car :test #'eq)))
(when (eq (cadar entry) :lexical-var)
entry)))
(defun variable-symbol-macro-p (var env)
- (let ((entry (member var (env-lexical-variables env) :key #'car)))
+ (let ((entry (member var (env-lexical-variables env) :key #'car :test #'eq)))
(when (eq (cadar entry) 'sb!sys:macro)
entry)))
((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))
(multiple-value-bind (newnewform macrop)
(walker-environment-bind
(new-env env :walk-form newform)
- (sb-xc:macroexpand-1 newform new-env))
+ (%macroexpand-1 newform new-env))
(cond
(macrop
(let ((newnewnewform (walk-form-internal newnewform
,(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
(null (get-walker-template (car form) form))
(progn
(multiple-value-setq (new-form macrop)
- (sb-xc:macroexpand-1 form env))
+ (%macroexpand-1 form env))
macrop))
;; This form was a call to a macro. Maybe it expanded
;; into a declare? Recurse to find out.
&aux arg)
(cond ((null arglist) ())
((symbolp (setq arg (car arglist)))
- (or (member arg lambda-list-keywords)
+ (or (member arg sb!xc:lambda-list-keywords :test #'eq)
(note-lexical-binding arg env))
(recons arglist
arg
context
env
(and destructuringp
- (not (member arg
- lambda-list-keywords))))))
+ (not (member arg sb!xc:lambda-list-keywords))))))
((consp arg)
(prog1 (recons arglist
(if destructuringp
(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