mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

chi-top-sequence defines macros before expanding other exps

Browse source 
* module/ice-9/psyntax.scm (chi-top-sequence): Manually inline
  eval-if-c&e into its two call sites; I found it hard to understand
  otherwise.  If the mode is just 'e, defer expansion of definitions and
  expressions until the end, so that they can be expanded in a context
  of all syntax expanders defined in the sequence.
This commit is contained in:
Andy Wingo 2011-02-27 12:48:23 +01:00
parent 4c2e13e548
commit 4da326f25d
1 changed files with 33 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

44
module/ice-9/psyntax.scm
View file

@ -897,15 +897,23 @@
(let ((first (chi (car body) r w mod)))
(cons first (dobody (cdr body) r w mod))))))))
;; At top-level, we allow mixed definitions and expressions. Like
;; chi-body we expand in two passes.
;;
;; First, from left to right, we expand just enough to know what
;; expressions are definitions, syntax definitions, and splicing
;; statements (`begin'). If we anything needs evaluating at
;; expansion-time, it is expanded directly.
;;
;; Otherwise we collect expressions to expand, in thunks, and then
;; expand them all at the end. This allows all syntax expanders
;; visible in a toplevel sequence to be visible during the
;; expansions of all normal definitions and expressions in the
;; sequence.
;;
(define chi-top-sequence
(lambda (body r w s m esew mod)
(define (scan body r w s m esew mod exps)
(define-syntax eval-if-c&e
(syntax-rules ()
((_ m e mod)
(let ((x e))
(if (eq? m 'c&e) (top-level-eval-hook x mod))
x))))
(cond
((null? body)
;; in reversed order
@ -1005,9 +1013,12 @@
(module-add! (current-module) n (make-undefined-variable)))))
(values
(cons
(eval-if-c&e m
(build-global-definition s n (chi e r w mod))
mod)
(if (eq? m 'c&e)
(let ((x (build-global-definition s n (chi e r w mod))))
(top-level-eval-hook x mod)
x)
(lambda ()
(build-global-definition s n (chi e r w mod))))
exps)))
((displaced-lexical)
(syntax-violation #f "identifier out of context"
@ -1017,7 +1028,12 @@
e (wrap value w mod))))))
(else
(values (cons
(eval-if-c&e m (chi-expr type value e r w s mod) mod)
(if (eq? m 'c&e)
(let ((x (chi-expr type value e r w s mod)))
(top-level-eval-hook x mod)
x)
(lambda ()
(chi-expr type value e r w s mod)))
exps)))))))
(lambda (exps)
(scan (cdr body) r w s m esew mod exps))))))
@ -1027,7 +1043,13 @@
(lambda (exps)
(if (null? exps)
(build-void s)
(build-sequence s (reverse exps)))))))
(build-sequence
s
(let lp ((in exps) (out '()))
(if (null? in) out
(let ((e (car in)))
(lp (cdr in)
(cons (if (procedure? e) (e) e) out)))))))))))
(define chi-install-global
(lambda (name e)