primitive-eval takes expanded, not memoized, source

* module/ice-9/eval.scm (primitive-eval):
* libguile/eval.c (scm_c_primitive_eval): Don't expect a memoized
  expression -- expect either raw source or an *expanded* expression. We
  handle memoization ourselves.

* libguile/expand.c (scm_macroexpand): Settle down into its proper name,
  "macroexpand", even as we comment that it is but a fleeting boot
  expander.
  (scm_macroexpanded_p): New predicate for expanded code.

* libguile/expand.h: Add scm_macroexpanded_p.

* libguile/memoize.c (scm_memoize_expression): Require that the
  expression be expanded.
  (scm_init_memoize): Don't alias memoize-expression to macroexpand.

* module/ice-9/psyntax-pp.scm:
* module/ice-9/psyntax.scm: Always produce macroexpanded expressions,
  and hand them to primitive-eval. No more calls to memoize-expression
  here.

* test-suite/tests/optargs.test: Remove some tests, as unfortunately we
  have no way to invoke the boot expander after boot.

libguile/eval.c

@@ -37,6 +37,7 @@
 #include "libguile/deprecation.h"
 #include "libguile/dynwind.h"
 #include "libguile/eq.h"
+#include "libguile/expand.h"
 #include "libguile/feature.h"
 #include "libguile/fluids.h"
 #include "libguile/goops.h"
@@ -832,13 +833,9 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
 static SCM
 scm_c_primitive_eval (SCM exp)
 {
-  if (!SCM_MEMOIZED_P (exp))
+  if (!SCM_EXPANDED_P (exp))
     exp = scm_call_1 (scm_current_module_transformer (), exp);
-  if (!SCM_MEMOIZED_P (exp))
+  return eval (scm_memoize_expression (exp), SCM_EOL);
-    scm_misc_error ("primitive-eval",
-                    "expander did not return a memoized expression",
-                    scm_list_1 (exp));
-  return eval (exp, SCM_EOL);
 }
 
 static SCM var_primitive_eval;

libguile/expand.c

@@ -1162,7 +1162,8 @@ expand_set_x (SCM expr, SCM env)
 
 
 
-SCM_DEFINE (scm_macroexpand, "macroexpand*", 1, 0, 0, 
+/* This is the boot expander. It is later replaced with psyntax's sc-expand. */
+SCM_DEFINE (scm_macroexpand, "macroexpand", 1, 0, 0, 
             (SCM exp),
 	    "Expand the expression @var{exp}.")
 #define FUNC_NAME s_scm_macroexpand
@@ -1171,6 +1172,15 @@ SCM_DEFINE (scm_macroexpand, "macroexpand*", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_macroexpanded_p, "macroexpanded?", 1, 0, 0, 
+            (SCM exp),
+	    "Return @code{#t} if @var{exp} is an expanded expression.")
+#define FUNC_NAME s_scm_macroexpanded_p
+{
+  return scm_from_bool (SCM_EXPANDED_P (exp));
+}
+#undef FUNC_NAME
+
 
  
 

libguile/expand.h

@@ -333,6 +333,7 @@ enum
 
 
 SCM_INTERNAL SCM scm_macroexpand (SCM exp);
+SCM_INTERNAL SCM scm_macroexpanded_p (SCM exp);
 
 SCM_INTERNAL void scm_init_expand (void);
 

libguile/memoize.c

@@ -404,8 +404,7 @@ SCM_DEFINE (scm_memoize_expression, "memoize-expression", 1, 0, 0,
 	    "Memoize the expression @var{exp}.")
 #define FUNC_NAME s_scm_memoize_expression
 {
-  if (!SCM_EXPANDED_P (exp))
+  SCM_ASSERT_TYPE (SCM_EXPANDED_P (exp), exp, 1, FUNC_NAME, "expanded");
-    exp = scm_macroexpand (exp);
   return memoize (exp, scm_current_module ());
 }
 #undef FUNC_NAME
@@ -803,8 +802,6 @@ scm_init_memoize ()
 
 #include "libguile/memoize.x"
 
-  scm_c_define ("macroexpand",
-                scm_variable_ref (scm_c_lookup ("memoize-expression")));
   list_of_guile = scm_list_1 (scm_from_locale_symbol ("guile"));
 }
 

module/ice-9/eval.scm

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

module/ice-9/psyntax.scm

@@ -307,11 +307,11 @@
 
     (define top-level-eval-hook
       (lambda (x mod)
-        (primitive-eval (memoize-expression x))))
+        (primitive-eval x)))
 
     (define local-eval-hook
       (lambda (x mod)
-        (primitive-eval (memoize-expression x))))
+        (primitive-eval x)))
     
     (define-syntax gensym-hook
       (syntax-rules ()
@@ -2397,10 +2397,7 @@
                           (cadr rest)))
                 (mod (cons 'hygiene (module-name (current-module)))))
             (with-fluids ((*mode* m))
-              (if (eq? m 'e)
+              (chi-top x null-env top-wrap m esew mod)))))
-                  (memoize-expression
-                   (chi-top x null-env top-wrap m esew mod))
-                  (chi-top x null-env top-wrap m esew mod))))))
   
   (set! identifier?
         (lambda (x)

test-suite/tests/optargs.test

@@ -45,34 +45,11 @@
                                exc (compile 'exp #:to 'value
                                             #:env (current-module)))))))
 
-(define-syntax c&m&e
-  (syntax-rules (pass-if pass-if-exception)
-    ((_ (pass-if test-name exp))
-     (begin (pass-if (string-append test-name " (eval)")
-                     (primitive-eval 'exp))
-            (pass-if (string-append test-name " (memoized eval)")
-                     (primitive-eval (memoize-expression 'exp)))
-            (pass-if (string-append test-name " (compile)")
-                     (compile 'exp #:to 'value #:env (current-module)))))
-    ((_ (pass-if-exception test-name exc exp))
-     (begin (pass-if-exception (string-append test-name " (eval)")
-                               exc (primitive-eval 'exp))
-            (pass-if-exception (string-append test-name " (memoized eval)")
-                               exc (primitive-eval (memoize-expression 'exp)))
-            (pass-if-exception (string-append test-name " (compile)")
-                               exc (compile 'exp #:to 'value
-                                            #:env (current-module)))))))
-
 (define-syntax with-test-prefix/c&e
   (syntax-rules ()
     ((_ section-name exp ...)
      (with-test-prefix section-name (c&e exp) ...))))
 
-(define-syntax with-test-prefix/c&m&e
-  (syntax-rules ()
-    ((_ section-name exp ...)
-     (with-test-prefix section-name (c&m&e exp) ...))))
-
 (with-test-prefix/c&e "optional argument processing"
   (pass-if "local defines work with optional arguments"
     (eval '(begin
@@ -197,7 +174,7 @@
       (equal? (f 1 2 3 #:x 'x #:z 'z)
               '(x #f z (1 2 3 #:x x #:z z))))))
 
-(with-test-prefix/c&m&e "lambda* inits"
+(with-test-prefix/c&e "lambda* inits"
   (pass-if "can bind lexicals within inits"
     (begin
       (define qux