- (let* ((result-cont (make-continuation))
- (*lexenv* (process-decls decls
- (append aux-vars vars)
- nil result-cont))
- (forms (if (and *allow-debug-catch-tag*
- (policy *lexenv* (= insert-debug-catch 3)))
- `((catch (make-symbol "SB-DEBUG-CATCH-TAG")
- ,@forms))
- forms))
- (res (if (or (find-if #'lambda-var-arg-info vars) keyp)
- (ir1-convert-hairy-lambda forms vars keyp
- allow-other-keys
- aux-vars aux-vals result-cont
- :source-name source-name
- :debug-name debug-name)
- (ir1-convert-lambda-body forms vars
- :aux-vars aux-vars
- :aux-vals aux-vals
- :result result-cont
- :source-name source-name
- :debug-name debug-name))))
+ (binding* (((*lexenv* result-type)
+ (process-decls decls (append aux-vars vars) nil))
+ (forms (if (and *allow-debug-catch-tag*
+ (policy *lexenv* (>= insert-debug-catch 2)))
+ `((catch (make-symbol "SB-DEBUG-CATCH-TAG")
+ ,@forms))
+ forms))
+ (forms (if (eq result-type *wild-type*)
+ forms
+ `((the ,result-type (progn ,@forms)))))
+ (res (if (or (find-if #'lambda-var-arg-info vars) keyp)
+ (ir1-convert-hairy-lambda forms vars keyp
+ allow-other-keys
+ aux-vars aux-vals
+ :source-name source-name
+ :debug-name debug-name)
+ (ir1-convert-lambda-body forms vars
+ :aux-vars aux-vars
+ :aux-vals aux-vals
+ :source-name source-name
+ :debug-name debug-name))))