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

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

File diff suppressed because it is too large Load diff

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

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