1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +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:
Andy Wingo 2010-05-07 10:51:28 +02:00
parent b79ba0b01e
commit 4f692ace90
7 changed files with 8224 additions and 8116 deletions

View file

@ -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)
'()

View file

@ -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

View file

@ -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)))