macro expanders return memoized expressions

* libguile/eval.c (scm_c_primitive_eval):
* module/ice-9/eval.scm (primitive-eval): Rely on the expander to
  produce a memoized expression. If the expression is already memoized,
  just pass it through (the equivalent of the old "noexpand" hack).

* libguile/memoize.c (scm_init_memoize): Initialize `memoize-expression'
  as the initial binding of `macroexpand'.

* libguile/modules.c (scm_module_transformer): Before modules are
  booted, look for `macroexpand', not `%pre-modules-transformer'.

* module/ice-9/boot-9.scm: No more %pre-modules-transformer. Loading
  psyntax extends `macroexpand'.
  (make-module): `macroexpand' is the default transformer.

* module/ice-9/psyntax.scm: No more `noexpand'.
  (top-level-eval-hook, local-eval-hook): Instead of annotating with
  noexpand, memoize the expression before handing it to primitive-eval.
  (macroexpand): No more noexpand hack -- in its place we have another
  hack, to memoize the result when running in eval mode.
* module/ice-9/psyntax-pp.scm: Regenerated.

libguile/eval.c

@@ -844,10 +844,12 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
 static SCM
 scm_c_primitive_eval (SCM exp)
 {
-  SCM transformer = scm_current_module_transformer ();
+  if (!SCM_MEMOIZED_P (exp))
-  if (scm_is_true (transformer))
+    exp = scm_call_1 (scm_current_module_transformer (), exp);
-    exp = scm_call_1 (transformer, exp);
+  if (!SCM_MEMOIZED_P (exp))
-  exp = scm_memoize_expression (exp);
+    scm_misc_error ("primitive-eval",
+                    "expander did not return a memoized expression",
+                    scm_list_1 (exp));
   return eval (exp, SCM_EOL);
 }
 

libguile/memoize.c

@@ -1326,6 +1326,9 @@ scm_init_memoize ()
   scm_set_smob_print (scm_tc16_memoized, scm_print_memoized);
 
 #include "libguile/memoize.x"
+
+  scm_c_define ("macroexpand",
+                scm_variable_ref (scm_c_lookup ("memoize-expression")));
 }
 
 /*

libguile/modules.c

@@ -564,7 +564,7 @@ scm_current_module_lookup_closure ()
     return SCM_BOOL_F;
 }
 
-SCM_SYMBOL (sym_sys_pre_modules_transformer, "%pre-modules-transformer");
+SCM_SYMBOL (sym_macroexpand, "macroexpand");
 
 SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
 	    (SCM module),
@@ -572,13 +572,13 @@ SCM_DEFINE (scm_module_transformer, "module-transformer", 1, 0, 0,
 #define FUNC_NAME s_scm_module_transformer
 {
   if (SCM_UNLIKELY (scm_is_false (module)))
-    { SCM v = scm_hashq_ref (scm_pre_modules_obarray,
+    {
-                             sym_sys_pre_modules_transformer,
+      SCM v = scm_hashq_ref (scm_pre_modules_obarray,
+                             sym_macroexpand,
                              SCM_BOOL_F);
       if (scm_is_false (v))
-        return SCM_BOOL_F;
+        SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL);
-      else
+      return SCM_VARIABLE_REF (v);
-        return SCM_VARIABLE_REF (v);
     }
   else
     {

module/ice-9/boot-9.scm

@@ -357,7 +357,6 @@ If there is no handler at all, Guile prints an error and then exits."
 (define generate-temporaries #f)
 (define bound-identifier=? #f)
 (define free-identifier=? #f)
-(define macroexpand #f)
 
 ;; $sc-dispatch is an implementation detail of psyntax. It is used by
 ;; expanded macros, to dispatch an input against a set of patterns.
@@ -365,10 +364,8 @@ If there is no handler at all, Guile prints an error and then exits."
 
 ;; Load it up!
 (primitive-load-path "ice-9/psyntax-pp")
-
+;; The binding for `macroexpand' has now been overridden, making psyntax the
-;; %pre-modules-transformer is the Scheme expander from now until the
+;; expander now.
-;; module system has booted up.
-(define %pre-modules-transformer macroexpand)
 
 (define-syntax and
   (syntax-rules ()
@@ -1606,7 +1603,7 @@ If there is no handler at all, Guile prints an error and then exits."
              "Lazy-binder expected to be a procedure or #f." binder))
 
         (let ((module (module-constructor (make-hash-table size)
-                                          uses binder #f %pre-modules-transformer
+                                          uses binder #f macroexpand
                                           #f #f #f
                                           (make-hash-table %default-import-size)
                                           '()

module/ice-9/eval.scm

@@ -332,8 +332,7 @@
     (lambda (exp)
       "Evaluate @var{exp} in the current module."
       (eval 
-       (memoize-expression ((or (module-transformer (current-module))
+       (if (memoized? exp)
-                                (lambda (x) x))
+           exp
-                            exp))
+           ((module-transformer (current-module)) exp))
        '()))))
-

module/ice-9/psyntax.scm

@@ -276,7 +276,6 @@
              ...))))))
 
 (let ()
-  (define noexpand "noexpand")
   (define *mode* (make-fluid))
 
 ;;; hooks to nonportable run-time helpers
@@ -289,18 +288,18 @@
     (define top-level-eval-hook
       (lambda (x mod)
         (primitive-eval
-         `(,noexpand
+         (memoize-expression
-           ,(case (fluid-ref *mode*)
+          (case (fluid-ref *mode*)
-              ((c) ((@ (language tree-il) tree-il->scheme) x))
+            ((c) ((@ (language tree-il) tree-il->scheme) x))
-              (else x))))))
+            (else x))))))
 
     (define local-eval-hook
       (lambda (x mod)
         (primitive-eval
-         `(,noexpand
+         (memoize-expression
-           ,(case (fluid-ref *mode*)
+          (case (fluid-ref *mode*)
-              ((c) ((@ (language tree-il) tree-il->scheme) x))
+            ((c) ((@ (language tree-il) tree-il->scheme) x))
-              (else x))))))
+            (else x))))))
 
     (define-syntax gensym-hook
       (syntax-rules ()
@@ -2450,16 +2449,17 @@
 ;;; the object file if we are compiling a file.
   (set! macroexpand
         (lambda (x . rest)
-          (if (and (pair? x) (equal? (car x) noexpand))
+          (let ((m (if (null? rest) 'e (car rest)))
-              (cadr x)
+                (esew (if (or (null? rest) (null? (cdr rest)))
-              (let ((m (if (null? rest) 'e (car rest)))
+                          '(eval)
-                    (esew (if (or (null? rest) (null? (cdr rest)))
+                          (cadr rest)))
-                              '(eval)
+                (mod (cons 'hygiene (module-name (current-module)))))
-                              (cadr rest))))
+            (with-fluids ((*mode* m))
-                (with-fluids ((*mode* m))
+              (if (eq? m 'e)
-                  (chi-top x null-env top-wrap m esew
+                  (memoize-expression
-                           (cons 'hygiene (module-name (current-module)))))))))
+                   (chi-top x null-env top-wrap m esew mod))
-
+                  (chi-top x null-env top-wrap m esew mod))))))
+  
   (set! identifier?
         (lambda (x)
           (nonsymbol-id? x)))