X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=3a3376a01756752cf7b3787c7743708c57b32d28;hb=aebbc5aad31f7e55930c996a8c54f0a135e00894;hp=38866b91d06be644c53f940c8a0cc2b05c314d42;hpb=cad792b6636677ceb5f3652f8d21292cfd073c55;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 38866b9..3a3376a 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -903,7 +903,7 @@ (declare (list decl vars) (type lexenv res)) (let ((type (compiler-specifier-type (first decl)))) (collect ((restr nil cons) - (new-vars nil cons)) + (new-vars nil cons)) (dolist (var-name (rest decl)) (let* ((bound-var (find-in-bindings vars var-name)) (var (or bound-var @@ -911,26 +911,31 @@ (find-free-var var-name)))) (etypecase var (leaf - (let* ((old-type (or (lexenv-find var type-restrictions) - (leaf-type var))) - (int (if (or (fun-type-p type) - (fun-type-p old-type)) - type - (type-approx-intersection2 old-type type)))) - (cond ((eq int *empty-type*) - (unless (policy *lexenv* (= inhibit-warnings 3)) - (compiler-warn - "The type declarations ~S and ~S for ~S conflict." - (type-specifier old-type) (type-specifier type) - var-name))) - (bound-var (setf (leaf-type bound-var) int)) - (t - (restr (cons var int)))))) + (flet ((process-var (var bound-var) + (let* ((old-type (or (lexenv-find var type-restrictions) + (leaf-type var))) + (int (if (or (fun-type-p type) + (fun-type-p old-type)) + type + (type-approx-intersection2 old-type type)))) + (cond ((eq int *empty-type*) + (unless (policy *lexenv* (= inhibit-warnings 3)) + (compiler-warn + "The type declarations ~S and ~S for ~S conflict." + (type-specifier old-type) (type-specifier type) + var-name))) + (bound-var (setf (leaf-type bound-var) int)) + (t + (restr (cons var int))))))) + (process-var var bound-var) + (awhen (and (lambda-var-p var) + (lambda-var-specvar var)) + (process-var it nil)))) (cons ;; FIXME: non-ANSI weirdness (aver (eq (car var) 'MACRO)) (new-vars `(,var-name . (MACRO . (the ,(first decl) - ,(cdr var)))))) + ,(cdr var)))))) (heap-alien-info (compiler-error "~S is an alien variable, so its type can't be declared."