mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

change form of @ and @@ psyntax handlers

Browse source 
* module/ice-9/psyntax.scm (@, @@): Take r and w args, and also return
  r, w, and s. Adapt callers.
This commit is contained in:
Andy Wingo 2010-05-06 00:15:06 +02:00
parent 807f7ab0ac
commit 9365d8ad3a
2 changed files with 8033 additions and 7966 deletions
Download patch file Download diff file Expand all files Collapse all files

15964
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

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

@ -1160,9 +1160,9 @@
(syntax-type (chi-macro fval e r w rib mod)
r empty-wrap s rib mod for-car?))
((module-ref)
(call-with-values (lambda () (fval e))
(lambda (sym mod)
(syntax-type sym r w s rib mod for-car?))))
(call-with-values (lambda () (fval e r w))
(lambda (e r w s mod)
(syntax-type e r w s rib mod for-car?))))
((core)
(values 'core-form fval e w s mod))
((local-syntax)
@ -1325,9 +1325,9 @@
;; apply transformer
(value e r w s mod))
((module-ref)
(call-with-values (lambda () (value e))
;; we could add a public? arg here
(lambda (id mod) (build-global-reference s id mod))))
(call-with-values (lambda () (value e r w))
(lambda (e r w s mod)
(chi e r w mod))))
((lexical-call)
(chi-application
(build-lexical-reference 'fun (source-annotation (car e))
@ -2213,9 +2213,12 @@
(case type
((module-ref)
(let ((val (chi #'val r w mod)))
(call-with-values (lambda () (value #'(head tail ...)))
(lambda (id mod)
(build-global-assignment s id val mod)))))
(call-with-values (lambda () (value #'(head tail ...) r w))
(lambda (e r w s* mod)
(syntax-case e ()
(e (id? #'e)
(build-global-assignment s (syntax->datum #'e)
val mod)))))))
(else
(build-application s
(chi #'(setter head) r w mod)
@ -2224,20 +2227,20 @@
(_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
(global-extend 'module-ref '@
(lambda (e)
(lambda (e r w)
(syntax-case e ()
((_ (mod ...) id)
(and (and-map id? #'(mod ...)) (id? #'id))
(values (syntax->datum #'id)
(values (syntax->datum #'id) r w #f
(syntax->datum
#'(public mod ...)))))))
(global-extend 'module-ref '@@
(lambda (e)
(lambda (e r w)
(syntax-case e ()
((_ (mod ...) id)
(and (and-map id? #'(mod ...)) (id? #'id))
(values (syntax->datum #'id)
(values (syntax->datum #'id) r w #f
(syntax->datum
#'(private mod ...)))))))