Update of /cvsroot/sbcl/sbcl/src/compiler
In directory usw-pr-cvs1:/tmp/cvs-serv11544/src/compiler
Modified Files:
ir1-translators.lisp lexenv.lisp target-main.lisp
Log Message:
0.7.9.6:
Fix bug 185 (top level forms at the REPL)
... implement a LOCALLY method for EVAL-IN-LEXENV
... factor out MACROLET-DEFINITIONIZE-FUN and
SYMBOL-MACROLET-DEFINITIONIZE-FUN from the IR1
translators for same
... implement SYMBOL-MACROLET and MACROLET for EVAL-IN-LEXENV
in terms of said DEFINITIONIZE-FUN macros and LOCALLY
... set compilation policy in make-target-2 to avoid file scope
limitations
... set interaction policy by hard-coding it in
MAKE-NULL-INTERACTIVE-LEXENV
... throw it together and hope it all still works.
Index: ir1-translators.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1-translators.lisp,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -d -r1.31 -r1.32
--- ir1-translators.lisp 17 Oct 2002 03:36:09 -0000 1.31
+++ ir1-translators.lisp 27 Oct 2002 14:52:49 -0000 1.32
@@ -252,35 +252,44 @@
(*lexenv* (make-lexenv definitionize-keyword processed-definitions)))
(funcall fun definitionize-keyword processed-definitions)))
-;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
+;;; Tweak LEXENV to include the DEFINITIONS from a MACROLET, then
;;; call FUN (with no arguments).
;;;
;;; This is split off from the IR1 convert method so that it can be
-;;; shared by the special-case top level MACROLET processing code.
+;;; shared by the special-case top level MACROLET processing code, and
+;;; further split so that the special-case MACROLET processing code in
+;;; EVAL can likewise make use of it.
+(defmacro macrolet-definitionize-fun (context lexenv)
+ (flet ((make-error-form (control &rest args)
+ (ecase context
+ (:compile `(compiler-error ,control ,@args))
+ (:eval `(error 'simple-program-error
+ :format-control ,control
+ :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))
+ (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")))
+ (multiple-value-bind (body local-decls)
+ (parse-defmacro arglist whole body name 'macrolet
+ :environment environment)
+ `(,name macro .
+ ,(compile-in-lexenv
+ nil
+ `(lambda (,whole ,environment)
+ ,@local-decls
+ (block ,name ,body))
+ ,lexenv))))))))
+
(defun funcall-in-macrolet-lexenv (definitions fun)
(%funcall-in-foomacrolet-lexenv
- (lambda (definition)
- (unless (list-of-length-at-least-p definition 2)
- (compiler-error
- "The list ~S is too short to be a legal local macro definition."
- definition))
- (destructuring-bind (name arglist &body body) definition
- (unless (symbolp name)
- (compiler-error "The local macro name ~S is not a symbol." name))
- (unless (listp arglist)
- (compiler-error "The local macro argument list ~S is not a list." arglist))
- (let ((whole (gensym "WHOLE"))
- (environment (gensym "ENVIRONMENT")))
- (multiple-value-bind (body local-decls)
- (parse-defmacro arglist whole body name 'macrolet
- :environment environment)
- `(,name macro .
- ,(compile-in-lexenv
- nil
- `(lambda (,whole ,environment)
- ,@local-decls
- (block ,name ,body))
- (make-restricted-lexenv *lexenv*)))))))
+ (macrolet-definitionize-fun :compile (make-restricted-lexenv *lexenv*))
:funs
definitions
fun))
@@ -298,20 +307,31 @@
(declare (ignore funs))
(ir1-translate-locally body start cont))))
-(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
- (%funcall-in-foomacrolet-lexenv
- (lambda (definition)
- (unless (proper-list-of-length-p definition 2)
- (compiler-error "malformed symbol/expansion pair: ~S" definition))
+(defmacro symbol-macrolet-definitionize-fun (context)
+ (flet ((make-error-form (control &rest args)
+ (ecase context
+ (:compile `(compiler-error ,control ,@args))
+ (:eval `(error 'simple-program-error
+ :format-control ,control
+ :format-arguments (list ,@args))))))
+ `(lambda (definition)
+ (unless (proper-list-of-length-p definition 2)
+ ,(make-error-form "malformed symbol/expansion pair: ~S" 'definition))
(destructuring-bind (name expansion) definition
(unless (symbolp name)
- (compiler-error
- "The local symbol macro name ~S is not a symbol."
- name))
+ ,(make-error-form
+ "The local symbol macro name ~S is not a symbol."
+ 'name))
(let ((kind (info :variable :kind name)))
(when (member kind '(:special :constant))
- (compiler-error "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S" kind name)))
- `(,name . (MACRO . ,expansion))))
+ ,(make-error-form
+ "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S"
+ 'kind 'name)))
+ `(,name . (MACRO . ,expansion))))))1
+
+(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
+ (%funcall-in-foomacrolet-lexenv
+ (symbol-macrolet-definitionize-fun :compile)
:vars
definitions
fun))
Index: lexenv.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/lexenv.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- lexenv.lisp 12 Oct 2002 05:57:46 -0000 1.11
+++ lexenv.lisp 27 Oct 2002 14:52:49 -0000 1.12
@@ -18,6 +18,13 @@
#!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place
(def!struct (lexenv
(:constructor make-null-lexenv ())
+ (:constructor make-null-interactive-lexenv
+ (&aux (policy (list '(safety . 3)
+ '(compilation-speed . 2)
+ '(speed . 1)
+ '(space . 1)
+ '(debug . 1)
+ '(inhibit-warnings . 1)))))
(:constructor internal-make-lexenv
(funs vars blocks tags type-restrictions
lambda cleanup policy)))
Index: target-main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/target-main.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- target-main.lisp 10 Oct 2002 07:16:15 -0000 1.12
+++ target-main.lisp 27 Oct 2002 14:52:49 -0000 1.13
@@ -61,6 +61,7 @@
(*last-format-args* nil)
(*last-message-count* 0)
(*gensym-counter* 0)
+ (*policy* (lexenv-policy *lexenv*))
;; FIXME: ANSI doesn't say anything about CL:COMPILE
;; interacting with these variables, so we shouldn't. As
;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
|