-(defun process-decls (decls vars fvars cont &optional (env *lexenv*))
- (declare (list decls vars fvars) (type continuation cont))
- (dolist (decl decls)
- (dolist (spec (rest decl))
- (unless (consp spec)
- (compiler-error "malformed declaration specifier ~S in ~S" spec decl))
- (setq env (process-1-decl spec env vars fvars cont))))
- env)
+(defun process-decls (decls vars fvars &optional (env *lexenv*))
+ (declare (list decls vars fvars))
+ (let ((result-type *wild-type*))
+ (dolist (decl decls)
+ (dolist (spec (rest decl))
+ (unless (consp spec)
+ (compiler-error "malformed declaration specifier ~S in ~S" spec decl))
+ (multiple-value-bind (new-env new-result-type)
+ (process-1-decl spec env vars fvars)
+ (setq env new-env)
+ (unless (eq new-result-type *wild-type*)
+ (setq result-type
+ (values-type-intersection result-type new-result-type))))))
+ (values env result-type)))
+
+(defun %processing-decls (decls vars fvars ctran lvar fun)
+ (multiple-value-bind (*lexenv* result-type)
+ (process-decls decls vars fvars)
+ (cond ((eq result-type *wild-type*)
+ (funcall fun ctran lvar))
+ (t
+ (let ((value-ctran (make-ctran))
+ (value-lvar (make-lvar)))
+ (multiple-value-prog1
+ (funcall fun value-ctran value-lvar)
+ (let ((cast (make-cast value-lvar result-type
+ (lexenv-policy *lexenv*))))
+ (link-node-to-previous-ctran cast value-ctran)
+ (setf (lvar-dest value-lvar) cast)
+ (use-continuation cast ctran lvar))))))))
+(defmacro processing-decls ((decls vars fvars ctran lvar) &body forms)
+ (check-type ctran symbol)
+ (check-type lvar symbol)
+ `(%processing-decls ,decls ,vars ,fvars ,ctran ,lvar
+ (lambda (,ctran ,lvar) ,@forms)))