mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

make syncase aware of (set! (@ (foo) bar) baz)

Browse source 
* module/ice-9/psyntax.scm (set!): Handle (set! (@ (foo ..) bar) val)
  inside syncase. Heh heh heh.

* module/ice-9/psyntax-pp.scm: Regenerated.
This commit is contained in:
Andy Wingo 2009-04-21 22:56:51 +02:00
parent 265e61273d
commit dec62b5ef8
2 changed files with 28 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because one or more lines are too long

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

@ -1132,7 +1132,7 @@
;; 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 r w s mod)) (call-with-values (lambda () (value e))
;; we could add a public? arg here ;; we could add a public? arg here
(lambda (id mod) (build-global-reference s id mod)))) (lambda (id mod) (build-global-reference s id mod))))
((lexical-call) ((lexical-call)
@ -1772,15 +1772,24 @@
(syntax-error (wrap (syntax id) w mod) (syntax-error (wrap (syntax id) w mod)
"identifier out of context")) "identifier out of context"))
(else (syntax-error (source-wrap e w s mod))))))) (else (syntax-error (source-wrap e w s mod)))))))
((_ (getter arg ...) val) ((_ (head tail ...) val)
(build-application s (call-with-values
(chi (syntax (setter getter)) r w mod) (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod))
(map (lambda (e) (chi e r w mod)) (lambda (type value ee ww ss modmod)
(syntax (arg ... val))))) (case type
((module-ref)
(call-with-values (lambda () (value (syntax (head tail ...))))
(lambda (id mod)
(build-global-assignment s id (syntax val) mod))))
(else
(build-application s
(chi (syntax (setter head)) r w mod)
(map (lambda (e) (chi e r w mod))
(syntax (tail ... val)))))))))
(_ (syntax-error (source-wrap e w s mod)))))) (_ (syntax-error (source-wrap e w s mod))))))
(global-extend 'module-ref '@ (global-extend 'module-ref '@
(lambda (e r w s mod) (lambda (e)
(syntax-case e (%module-public-interface) (syntax-case e (%module-public-interface)
((_ (mod ...) id) ((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id))) (and (andmap id? (syntax (mod ...))) (id? (syntax id)))
@ -1789,7 +1798,7 @@
(syntax (mod ... %module-public-interface)))))))) (syntax (mod ... %module-public-interface))))))))
(global-extend 'module-ref '@@ (global-extend 'module-ref '@@
(lambda (e r w s mod) (lambda (e)
(syntax-case e () (syntax-case e ()
((_ (mod ...) id) ((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id))) (and (andmap id? (syntax (mod ...))) (id? (syntax id)))