- (let ((n-required-arguments (length required-arguments))
- (n-optional-arguments (length optional-arguments))
- (*environment* (extend-local-env
- (append (ensure-list rest-argument)
- required-arguments
- optional-arguments
- keyword-arguments
- (ll-svars ll)))))
- (lambda-docstring-wrapper
- documentation
- "(function ("
- (join (cons "values"
- (mapcar #'translate-variable
- (append required-arguments optional-arguments)))
- ",")
- "){" *newline*
- (indent
- ;; Check number of arguments
- (lambda-check-argument-count n-required-arguments
- n-optional-arguments
- (or rest-argument keyword-arguments))
- (compile-lambda-optional ll)
- (compile-lambda-rest ll)
- (compile-lambda-parse-keywords ll)
- (let ((*multiple-value-p* t))
- (ls-compile-block body t)))
- "})"))))
+ (values body value-declarations value-docstring)))
+
+;;; Compile a lambda function with lambda list LL and body BODY. If
+;;; NAME is given, it should be a constant string and it will become
+;;; the name of the function. If BLOCK is non-NIL, a named block is
+;;; created around the body. NOTE: No block (even anonymous) is
+;;; created if BLOCk is NIL.
+(defun compile-lambda (ll body &key name block)
+ (multiple-value-bind (required-arguments
+ optional-arguments
+ keyword-arguments
+ rest-argument)
+ (parse-lambda-list ll)
+ (multiple-value-bind (body decls documentation)
+ (parse-body body :declarations t :docstring t)
+ (declare (ignore decls))
+ (let ((n-required-arguments (length required-arguments))
+ (n-optional-arguments (length optional-arguments))
+ (*environment* (extend-local-env
+ (append (ensure-list rest-argument)
+ required-arguments
+ optional-arguments
+ keyword-arguments
+ (ll-svars ll)))))
+ (lambda-name/docstring-wrapper name documentation
+ "(function ("
+ (join (list* "values"
+ "nargs"
+ (mapcar #'translate-variable
+ (append required-arguments optional-arguments)))
+ ",")
+ "){" *newline*
+ (indent
+ ;; Check number of arguments
+ (lambda-check-argument-count n-required-arguments
+ n-optional-arguments
+ (or rest-argument keyword-arguments))
+ (compile-lambda-optional ll)
+ (compile-lambda-rest ll)
+ (compile-lambda-parse-keywords ll)
+ (let ((*multiple-value-p* t))
+ (if block
+ (ls-compile-block `((block ,block ,@body)) t)
+ (ls-compile-block body t))))
+ "})")))))