mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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))) (let ((first (chi (car body) r w mod)))
(cons first (dobody (cdr 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 (define chi-top-sequence
(lambda (body r w s m esew mod) (lambda (body r w s m esew mod)
(define (scan body r w s m esew mod exps) (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 (cond
((null? body) ((null? body)
;; in reversed order ;; in reversed order
@ -1005,9 +1013,12 @@
(module-add! (current-module) n (make-undefined-variable))))) (module-add! (current-module) n (make-undefined-variable)))))
(values (values
(cons (cons
(eval-if-c&e m (if (eq? m 'c&e)
(build-global-definition s n (chi e r w mod)) (let ((x (build-global-definition s n (chi e r w mod))))
mod) (top-level-eval-hook x mod)
x)
(lambda ()
(build-global-definition s n (chi e r w mod))))
exps))) exps)))
((displaced-lexical) ((displaced-lexical)
(syntax-violation #f "identifier out of context" (syntax-violation #f "identifier out of context"
@ -1017,7 +1028,12 @@
e (wrap value w mod)))))) e (wrap value w mod))))))
(else (else
(values (cons (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))))))) exps)))))))
(lambda (exps) (lambda (exps)
(scan (cdr body) r w s m esew mod exps)))))) (scan (cdr body) r w s m esew mod exps))))))
@ -1027,7 +1043,13 @@
(lambda (exps) (lambda (exps)
(if (null? exps) (if (null? exps)
(build-void s) (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 (define chi-install-global
(lambda (name e) (lambda (name e)