mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

@@ generalized to arbitrary expressions.

Browse source 
* module/ice-9/psyntax.scm (@@): The RHS of an @@ is no longer
  restricted to be an identifier, it can be an arbitrary expression.

* module/ice-9/psyntax-pp.scm: Regenerated.
This commit is contained in:
Andy Wingo 2010-05-06 21:12:09 +02:00
parent 9365d8ad3a
commit 27cbec84da
2 changed files with 8462 additions and 8263 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -2237,12 +2237,30 @@
(global-extend 'module-ref '@@ (global-extend 'module-ref '@@
(lambda (e r w) (lambda (e r w)
(define remodulate
(lambda (x mod)
(cond ((pair? x)
(cons (remodulate (car x) mod)
(remodulate (cdr x) mod)))
((syntax-object? x)
(make-syntax-object
(remodulate (syntax-object-expression x) mod)
(syntax-object-wrap x)
;; hither the remodulation
mod))
((vector? x)
(let* ((n (vector-length x)) (v (make-vector n)))
(do ((i 0 (fx+ i 1)))
((fx= i n) v)
(vector-set! v i (remodulate (vector-ref x i) mod)))))
(else x))))
(syntax-case e () (syntax-case e ()
((_ (mod ...) id) ((_ (mod ...) exp)
(and (and-map id? #'(mod ...)) (id? #'id)) (and-map id? #'(mod ...))
(values (syntax->datum #'id) r w #f (let ((mod (syntax->datum #'(private mod ...))))
(syntax->datum (values (remodulate #'exp mod)
#'(private mod ...))))))) r w (source-annotation #'exp)
mod))))))
(global-extend 'core 'if (global-extend 'core 'if
(lambda (e r w s mod) (lambda (e r w s mod)