`(%with-compilation-unit (lambda () ,@body) ,@options))
(defun %with-compilation-unit (fn &key override)
+ (declare (type function fn))
(let ((succeeded-p nil))
(if (and *in-compilation-unit* (not override))
;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is
;;; Process a top level use of LOCALLY, or anything else (e.g.
;;; MACROLET) at top level which has declarations and ordinary forms.
;;; We parse declarations and then recursively process the body.
-(defun process-toplevel-locally (body path compile-time-too)
+(defun process-toplevel-locally (body path compile-time-too &key vars funs)
(declare (list path))
(multiple-value-bind (forms decls) (parse-body body nil)
(let* ((*lexenv*
- (process-decls decls nil nil (make-continuation)))
+ (process-decls decls vars funs (make-continuation)))
;; Binding *POLICY* is pretty much of a hack, since it
;; causes LOCALLY to "capture" enclosed proclamations. It
;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
(setf (component-name component)
(debug-namify "~S initial component" name))
(setf (component-kind component) :initial)
- (let* ((locall-fun (ir1-convert-lambda
- definition
- :debug-name (debug-namify "top level local call ~S"
- name)))
+ (let* ((locall-fun (ir1-convert-lambdalike
+ definition
+ :debug-name (debug-namify "top level local call ~S"
+ name)
+ ;; KLUDGE: we do this so that we get to have
+ ;; nice debug returnness in functions defined
+ ;; from the REPL
+ :allow-debug-catch-tag t))
(fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun)
:source-name (or name '.anonymous.)
:debug-name (unless name
"top level form"))))
+ (when name
+ (assert-global-function-definition-type name locall-fun))
(setf (functional-entry-fun fun) locall-fun
(functional-kind fun) :external
(functional-has-external-references-p fun) t)
(compile-component component-from-dfo)
(replace-toplevel-xeps component-from-dfo)))
- (prog1
- (let ((entry-table (etypecase *compile-object*
- (fasl-output (fasl-output-entry-table
- *compile-object*))
- (core-object (core-object-entry-table
- *compile-object*)))))
- (multiple-value-bind (result found-p)
- (gethash (leaf-info fun) entry-table)
- (aver found-p)
- result))
- ;; KLUDGE: This code duplicates some other code in this
- ;; file. In the great reorganzation, the flow of program logic
- ;; changed from the original CMUCL model, and that path (as of
- ;; sbcl-0.7.5 in SUB-COMPILE-FILE) was no longer followed for
- ;; CORE-OBJECTS, leading to BUG 156. This place is
- ;; transparently not the right one for this code, but I don't
- ;; have a clear enough overview of the compiler to know how to
- ;; rearrange it all so that this operation fits in nicely, and
- ;; it was blocking reimplementation of
- ;; (DECLAIM (INLINE FOO)) (MACROLET ((..)) (DEFUN FOO ...))
- ;;
- ;; FIXME: This KLUDGE doesn't solve all the problem in an
- ;; ideal way, as (1) definitions typed in at the REPL without
- ;; an INLINE declaration will give a NULL
- ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal) and
- ;; (2) INLINE declarations will yield a
- ;; FUNCTION-LAMBDA-EXPRESSION headed by
- ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV.
- ;;
- ;; CSR, 2002-07-02
- (when (core-object-p *compile-object*)
- (fix-core-source-info *source-info* *compile-object*))
-
- (mapc #'clear-ir1-info components-from-dfo)
- (clear-stuff)))))
+ (let ((entry-table (etypecase *compile-object*
+ (fasl-output (fasl-output-entry-table
+ *compile-object*))
+ (core-object (core-object-entry-table
+ *compile-object*)))))
+ (multiple-value-bind (result found-p)
+ (gethash (leaf-info fun) entry-table)
+ (aver found-p)
+ (prog1
+ result
+ ;; KLUDGE: This code duplicates some other code in this
+ ;; file. In the great reorganzation, the flow of program
+ ;; logic changed from the original CMUCL model, and that
+ ;; path (as of sbcl-0.7.5 in SUB-COMPILE-FILE) was no
+ ;; longer followed for CORE-OBJECTS, leading to BUG
+ ;; 156. This place is transparently not the right one for
+ ;; this code, but I don't have a clear enough overview of
+ ;; the compiler to know how to rearrange it all so that
+ ;; this operation fits in nicely, and it was blocking
+ ;; reimplementation of (DECLAIM (INLINE FOO)) (MACROLET
+ ;; ((..)) (DEFUN FOO ...))
+ ;;
+ ;; FIXME: This KLUDGE doesn't solve all the problem in an
+ ;; ideal way, as (1) definitions typed in at the REPL
+ ;; without an INLINE declaration will give a NULL
+ ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal)
+ ;; and (2) INLINE declarations will yield a
+ ;; FUNCTION-LAMBDA-EXPRESSION headed by
+ ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV. -- CSR,
+ ;; 2002-07-02
+ ;;
+ ;; (2) is probably fairly easy to fix -- it is, after all,
+ ;; a matter of list manipulation (or possibly of teaching
+ ;; CL:FUNCTION about SB-C:LAMBDA-WITH-LEXENV). (1) is
+ ;; significantly harder, as the association between
+ ;; function object and source is a tricky one.
+ ;;
+ ;; FUNCTION-LAMBDA-EXPRESSION "works" (i.e. returns a
+ ;; non-NULL list) when the function in question has been
+ ;; compiled by (COMPILE <x> '(LAMBDA ...)); it does not
+ ;; work when it has been compiled as part of the top-level
+ ;; EVAL strategy of compiling everything inside (LAMBDA ()
+ ;; ...). -- CSR, 2002-11-02
+ (when (core-object-p *compile-object*)
+ (fix-core-source-info *source-info* *compile-object* result))
+
+ (mapc #'clear-ir1-info components-from-dfo)
+ (clear-stuff)))))))
(defun process-toplevel-cold-fset (name lambda-expression path)
(unless (producing-fasl-file)
compile-time-too))))))
(if (atom form)
#+sb-xc-host
- ;; (There are no EVAL-WHEN issues in the ATOM case until
- ;; SBCL gets smart enough to handle global
- ;; DEFINE-SYMBOL-MACRO or SYMBOL-MACROLET.)
+ ;; (There are no xc EVAL-WHEN issues in the ATOM case until
+ ;; (1) SBCL gets smart enough to handle global
+ ;; DEFINE-SYMBOL-MACRO or SYMBOL-MACROLET and (2) SBCL
+ ;; implementors start using symbol macros in a way which
+ ;; interacts with SB-XC/CL distinction.)
(convert-and-maybe-compile form path)
#-sb-xc-host
(default-processor form)
((macrolet)
(funcall-in-macrolet-lexenv
magic
- (lambda ()
+ (lambda (&key funs)
+ (declare (ignore funs))
(process-toplevel-locally body
path
compile-time-too))))
((symbol-macrolet)
(funcall-in-symbol-macrolet-lexenv
magic
- (lambda ()
+ (lambda (&key vars)
(process-toplevel-locally body
path
- compile-time-too)))))))
+ compile-time-too
+ :vars vars)))))))
((locally)
(process-toplevel-locally (rest form) path compile-time-too))
((progn)