:format-arguments (list ,@args))))))
`(lambda (definition)
(unless (list-of-length-at-least-p definition 2)
- ,(make-error-form "The list ~S is too short to be a legal local macro definition." 'definition))
+ ,(make-error-form
+ "The list ~S is too short to be a legal local macro definition."
+ 'definition))
(destructuring-bind (name arglist &body body) definition
(unless (symbolp name)
,(make-error-form "The local macro name ~S is not a symbol." 'name))
(unless (listp arglist)
- ,(make-error-form "The local macro argument list ~S is not a list." 'arglist))
- (let ((whole (gensym "WHOLE"))
- (environment (gensym "ENVIRONMENT")))
+ ,(make-error-form
+ "The local macro argument list ~S is not a list."
+ 'arglist))
+ (with-unique-names (whole environment)
(multiple-value-bind (body local-decls)
(parse-defmacro arglist whole body name 'macrolet
:environment environment)
During evaluation of the Forms, bind the Vars to the result of evaluating the
Value forms. The variables are bound in parallel after all of the Values are
evaluated."
- (multiple-value-bind (forms decls) (parse-body body nil)
- (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
- (let ((fun-cont (make-continuation)))
- (let* ((*lexenv* (process-decls decls vars nil cont))
- (fun (ir1-convert-lambda-body
- forms vars
- :debug-name (debug-namify "LET ~S" bindings))))
- (reference-leaf start fun-cont fun))
- (ir1-convert-combination-args fun-cont cont values)))))
+ (if (null bindings)
+ (ir1-translate-locally body start cont)
+ (multiple-value-bind (forms decls) (parse-body body nil)
+ (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
+ (let ((fun-cont (make-continuation)))
+ (let* ((*lexenv* (process-decls decls vars nil cont))
+ (fun (ir1-convert-lambda-body
+ forms vars
+ :debug-name (debug-namify "LET ~S" bindings))))
+ (reference-leaf start fun-cont fun))
+ (ir1-convert-combination-args fun-cont cont values))))))
(def-ir1-translator let* ((bindings &body body)
start cont)
;;; many branches there are going to be.
(defun ir1ize-the-or-values (type cont lexenv place)
(declare (type continuation cont) (type lexenv lexenv))
- (let* ((atype (if (typep type 'ctype) type (compiler-values-specifier-type type)))
+ (let* ((atype (if (typep type 'ctype)
+ type
+ (compiler-values-specifier-type type)))
(old-atype (or (lexenv-find cont type-restrictions)
*wild-type*))
(old-ctype (or (lexenv-find cont weakend-type-restrictions)
(intersects (values-types-equal-or-intersect old-atype atype))
(new-atype (values-type-intersection old-atype atype))
(new-ctype (values-type-intersection
- old-ctype (maybe-weaken-check atype (lexenv-policy lexenv)))))
+ old-ctype
+ (maybe-weaken-check atype (lexenv-policy lexenv)))))
(when (null (find-uses cont))
(setf (continuation-asserted-type cont) new-atype)
(setf (continuation-type-to-check cont) new-ctype))
(setf (functional-kind fun) :cleanup)
(reference-leaf start cont fun)))
-;;; We represent the possibility of the control transfer by making an
-;;; "escape function" that does a lexical exit, and instantiate the
-;;; cleanup using %WITHIN-CLEANUP.
(def-ir1-translator catch ((tag &body body) start cont)
#!+sb-doc
"Catch Tag Form*
- Evaluates Tag and instantiates it as a catcher while the body forms are
- evaluated in an implicit PROGN. If a THROW is done to Tag within the dynamic
+ Evaluate TAG and instantiate it as a catcher while the body forms are
+ evaluated in an implicit PROGN. If a THROW is done to TAG within the dynamic
scope of the body, then control will be transferred to the end of the body
and the thrown values will be returned."
+ ;; We represent the possibility of the control transfer by making an
+ ;; "escape function" that does a lexical exit, and instantiate the
+ ;; cleanup using %WITHIN-CLEANUP.
(ir1-convert
start cont
- (let ((exit-block (gensym "EXIT-BLOCK-")))
+ (with-unique-names (exit-block)
`(block ,exit-block
(%within-cleanup
:catch
(%catch (%escape-fun ,exit-block) ,tag)
,@body)))))
-;;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the
-;;; cleanup forms into a local function so that they can be referenced
-;;; both in the case where we are unwound and in any local exits. We
-;;; use %CLEANUP-FUN on this to indicate that reference by
-;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
-;;; an XEP.
(def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
#!+sb-doc
"Unwind-Protect Protected Cleanup*
- Evaluate the form Protected, returning its values. The cleanup forms are
- evaluated whenever the dynamic scope of the Protected form is exited (either
+ Evaluate the form PROTECTED, returning its values. The CLEANUP forms are
+ evaluated whenever the dynamic scope of the PROTECTED form is exited (either
due to normal completion or a non-local exit such as THROW)."
+ ;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the
+ ;; cleanup forms into a local function so that they can be referenced
+ ;; both in the case where we are unwound and in any local exits. We
+ ;; use %CLEANUP-FUN on this to indicate that reference by
+ ;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
+ ;; an XEP.
(ir1-convert
start cont
- (let ((cleanup-fun (gensym "CLEANUP-FUN-"))
- (drop-thru-tag (gensym "DROP-THRU-TAG-"))
- (exit-tag (gensym "EXIT-TAG-"))
- (next (gensym "NEXT"))
- (start (gensym "START"))
- (count (gensym "COUNT")))
+ (with-unique-names (cleanup-fun drop-thru-tag exit-tag next start count)
`(flet ((,cleanup-fun () ,@cleanup nil))
;; FIXME: If we ever get DYNAMIC-EXTENT working, then
;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT,
\f
;;;; multiple-value stuff
-;;; If there are arguments, MULTIPLE-VALUE-CALL turns into an
-;;; MV-COMBINATION.
-;;;
-;;; If there are no arguments, then we convert to a normal
-;;; combination, ensuring that a MV-COMBINATION always has at least
-;;; one argument. This can be regarded as an optimization, but it is
-;;; more important for simplifying compilation of MV-COMBINATIONS.
(def-ir1-translator multiple-value-call ((fun &rest args) start cont)
#!+sb-doc
"MULTIPLE-VALUE-CALL Function Values-Form*
- Call Function, passing all the values of each Values-Form as arguments,
- values from the first Values-Form making up the first argument, etc."
+ Call FUNCTION, passing all the values of each VALUES-FORM as arguments,
+ values from the first VALUES-FORM making up the first argument, etc."
(let* ((fun-cont (make-continuation))
(node (if args
+ ;; If there are arguments, MULTIPLE-VALUE-CALL
+ ;; turns into an MV-COMBINATION.
(make-mv-combination fun-cont)
+ ;; If there are no arguments, then we convert to a
+ ;; normal combination, ensuring that a MV-COMBINATION
+ ;; always has at least one argument. This can be
+ ;; regarded as an optimization, but it is more
+ ;; important for simplifying compilation of
+ ;; MV-COMBINATIONS.
(make-combination fun-cont))))
(ir1-convert start fun-cont
(if (and (consp fun) (eq (car fun) 'function))
projects / sbcl.git / blobdiff