(declare (type list definitions))
(unless (= (length definitions)
(length (remove-duplicates definitions :key #'first)))
(declare (type list definitions))
(unless (= (length definitions)
(length (remove-duplicates definitions :key #'first)))
`(lambda (,whole ,environment)
,@local-decls
(block ,name ,body))))))))
`(lambda (,whole ,environment)
,@local-decls
(block ,name ,body))))))))
"The local symbol macro name ~S is not a symbol."
name))
`(,name . (MACRO . ,expansion))))
"The local symbol macro name ~S is not a symbol."
name))
`(,name . (MACRO . ,expansion))))
;;; variables are marked as such. Context is the name of the form, for
;;; error reporting purposes.
(declaim (ftype (function (list symbol) (values list list list))
;;; variables are marked as such. Context is the name of the form, for
;;; error reporting purposes.
(declaim (ftype (function (list symbol) (values list list list))
Value forms. The variables are bound in parallel after all of the Values are
evaluated."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
Value forms. The variables are bound in parallel after all of the Values are
evaluated."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
(let* ((*lexenv* (process-decls decls vars nil cont))
(fun-cont (make-continuation))
(fun (ir1-convert-lambda-body
(let* ((*lexenv* (process-decls decls vars nil cont))
(fun-cont (make-continuation))
(fun (ir1-convert-lambda-body
Similar to LET, but the variables are bound sequentially, allowing each Value
form to reference any of the previous Vars."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
Similar to LET, but the variables are bound sequentially, allowing each Value
form to reference any of the previous Vars."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
(let ((*lexenv* (process-decls decls vars nil cont)))
(ir1-convert-aux-bindings start cont forms vars values)))))
(let ((*lexenv* (process-decls decls vars nil cont)))
(ir1-convert-aux-bindings start cont forms vars values)))))
;;;
;;; The function names are checked for legality. CONTEXT is the name
;;; of the form, for error reporting.
;;;
;;; The function names are checked for legality. CONTEXT is the name
;;; of the form, for error reporting.
-(declaim (ftype (function (list symbol) (values list list))
- extract-flet-variables))
-(defun extract-flet-variables (definitions context)
+(declaim (ftype (function (list symbol) (values list list)) extract-flet-vars))
+(defun extract-flet-vars (definitions context)
the lexically apparent function definition in the enclosing environment."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
(multiple-value-bind (names defs)
the lexically apparent function definition in the enclosing environment."
(multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
(multiple-value-bind (names defs)
(ir1-convert-progn-body start cont forms)))))
(def-ir1-translator labels ((definitions &body body) start cont)
(ir1-convert-progn-body start cont forms)))))
(def-ir1-translator labels ((definitions &body body) start cont)
(let* (;; dummy LABELS functions, to be used as placeholders
;; during construction of real LABELS functions
(placeholder-funs (mapcar (lambda (name)
(let* (;; dummy LABELS functions, to be used as placeholders
;; during construction of real LABELS functions
(placeholder-funs (mapcar (lambda (name)
;; the real LABELS functions, compiled in a LEXENV which
;; includes the dummy LABELS functions
(real-funs
;; the real LABELS functions, compiled in a LEXENV which
;; includes the dummy LABELS functions
(real-funs
;; placeholder used earlier) so that if the
;; lexical environment is used for inline
;; expansion we'll get the right functions.
;; placeholder used earlier) so that if the
;; lexical environment is used for inline
;; expansion we'll get the right functions.
(ir1-convert-progn-body start cont forms))))))
\f
;;;; the THE special operator, and friends
(ir1-convert-progn-body start cont forms))))))
\f
;;;; the THE special operator, and friends
-;;; If there is a definition in LEXENV-VARIABLES, just set that,
-;;; otherwise look at the global information. If the name is for a
-;;; constant, then error out.
+;;; If there is a definition in LEXENV-VARS, just set that, otherwise
+;;; look at the global information. If the name is for a constant,
+;;; then error out.
(def-ir1-translator setq ((&whole source &rest things) start cont)
(let ((len (length things)))
(when (oddp len)
(compiler-error "odd number of args to SETQ: ~S" source))
(if (= len 2)
(let* ((name (first things))
(def-ir1-translator setq ((&whole source &rest things) start cont)
(let ((len (length things)))
(when (oddp len)
(compiler-error "odd number of args to SETQ: ~S" source))
(if (= len 2)
(let* ((name (first things))
(cons
(aver (eq (car leaf) 'MACRO))
(ir1-convert start cont `(setf ,(cdr leaf) ,(second things))))
(cons
(aver (eq (car leaf) 'MACRO))
(ir1-convert start cont `(setf ,(cdr leaf) ,(second things))))
;;; This is kind of like REFERENCE-LEAF, but we generate a SET node.
;;; This should only need to be called in SETQ.
;;; This is kind of like REFERENCE-LEAF, but we generate a SET node.
;;; This should only need to be called in SETQ.
(declare (type continuation start cont) (type basic-var var))
(let ((dest (make-continuation)))
(setf (continuation-asserted-type dest) (leaf-type var))
(declare (type continuation start cont) (type basic-var var))
(let ((dest (make-continuation)))
(setf (continuation-asserted-type dest) (leaf-type var))
;;;
;;; Note that environment analysis replaces references to escape
;;; functions with references to the corresponding NLX-INFO structure.
;;;
;;; Note that environment analysis replaces references to escape
;;; functions with references to the corresponding NLX-INFO structure.
(let ((fun (ir1-convert-lambda
`(lambda ()
(return-from ,tag (%unknown-values)))
(let ((fun (ir1-convert-lambda
`(lambda ()
(return-from ,tag (%unknown-values)))
;;; Yet another special special form. This one looks up a local
;;; function and smashes it to a :CLEANUP function, as well as
;;; referencing it.
;;; Yet another special special form. This one looks up a local
;;; function and smashes it to a :CLEANUP function, as well as
;;; referencing it.
,@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
,@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
;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
;;; an XEP.
(def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
;;; an XEP.
(def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
`(flet ((,cleanup-fun () ,@cleanup nil))
;; FIXME: If we ever get DYNAMIC-EXTENT working, then
;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT,
`(flet ((,cleanup-fun () ,@cleanup nil))
;; FIXME: If we ever get DYNAMIC-EXTENT working, then
;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT,
;; dynamic extent too.
(block ,drop-thru-tag
(multiple-value-bind (,next ,start ,count)
(block ,exit-tag
(%within-cleanup
:unwind-protect
;; dynamic extent too.
(block ,drop-thru-tag
(multiple-value-bind (,next ,start ,count)
(block ,exit-tag
(%within-cleanup
:unwind-protect
- (%unwind-protect (%escape-function ,exit-tag)
- (%cleanup-function ,cleanup-fun))
+ (%unwind-protect (%escape-fun ,exit-tag)
+ (%cleanup-fun ,cleanup-fun))
(return-from ,drop-thru-tag ,protected)))
(,cleanup-fun)
(%continue-unwind ,next ,start ,count)))))))
(return-from ,drop-thru-tag ,protected)))
(,cleanup-fun)
(%continue-unwind ,next ,start ,count)))))))