mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
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.
This commit is contained in:
parent
b79ba0b01e
commit
4f692ace90
7 changed files with 8224 additions and 8116 deletions
|
@ -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_is_true (transformer))
|
||||
exp = scm_call_1 (transformer, exp);
|
||||
exp = scm_memoize_expression (exp);
|
||||
if (!SCM_MEMOIZED_P (exp))
|
||||
exp = scm_call_1 (scm_current_module_transformer (), exp);
|
||||
if (!SCM_MEMOIZED_P (exp))
|
||||
scm_misc_error ("primitive-eval",
|
||||
"expander did not return a memoized expression",
|
||||
scm_list_1 (exp));
|
||||
return eval (exp, SCM_EOL);
|
||||
}
|
||||
|
||||
|
|
|
@ -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")));
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
|
@ -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;
|
||||
else
|
||||
return SCM_VARIABLE_REF (v);
|
||||
SCM_MISC_ERROR ("no module, and `macroexpand' unbound", SCM_EOL);
|
||||
return SCM_VARIABLE_REF (v);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
|
@ -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")
|
||||
|
||||
;; %pre-modules-transformer is the Scheme expander from now until the
|
||||
;; module system has booted up.
|
||||
(define %pre-modules-transformer macroexpand)
|
||||
;; The binding for `macroexpand' has now been overridden, making psyntax the
|
||||
;; expander now.
|
||||
|
||||
(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)
|
||||
'()
|
||||
|
|
|
@ -332,8 +332,7 @@
|
|||
(lambda (exp)
|
||||
"Evaluate @var{exp} in the current module."
|
||||
(eval
|
||||
(memoize-expression ((or (module-transformer (current-module))
|
||||
(lambda (x) x))
|
||||
exp))
|
||||
(if (memoized? exp)
|
||||
exp
|
||||
((module-transformer (current-module)) exp))
|
||||
'()))))
|
||||
|
||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -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
|
||||
,(case (fluid-ref *mode*)
|
||||
((c) ((@ (language tree-il) tree-il->scheme) x))
|
||||
(else x))))))
|
||||
(memoize-expression
|
||||
(case (fluid-ref *mode*)
|
||||
((c) ((@ (language tree-il) tree-il->scheme) x))
|
||||
(else x))))))
|
||||
|
||||
(define local-eval-hook
|
||||
(lambda (x mod)
|
||||
(primitive-eval
|
||||
`(,noexpand
|
||||
,(case (fluid-ref *mode*)
|
||||
((c) ((@ (language tree-il) tree-il->scheme) x))
|
||||
(else x))))))
|
||||
(memoize-expression
|
||||
(case (fluid-ref *mode*)
|
||||
((c) ((@ (language tree-il) tree-il->scheme) 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))
|
||||
(cadr x)
|
||||
(let ((m (if (null? rest) 'e (car rest)))
|
||||
(esew (if (or (null? rest) (null? (cdr rest)))
|
||||
'(eval)
|
||||
(cadr rest))))
|
||||
(with-fluids ((*mode* m))
|
||||
(chi-top x null-env top-wrap m esew
|
||||
(cons 'hygiene (module-name (current-module)))))))))
|
||||
|
||||
(let ((m (if (null? rest) 'e (car rest)))
|
||||
(esew (if (or (null? rest) (null? (cdr rest)))
|
||||
'(eval)
|
||||
(cadr rest)))
|
||||
(mod (cons 'hygiene (module-name (current-module)))))
|
||||
(with-fluids ((*mode* m))
|
||||
(if (eq? m 'e)
|
||||
(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)
|
||||
(nonsymbol-id? x)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue