mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

psyntax: enable dotted tail patterns

Browse source 
* module/ice-9/psyntax.scm (syntax-case): enabled the use of a
  general last cdr instead of just '() in matching with both
  a ellipsis (p ...) and a last rest pattern (. q)

* module/ice-9/psyntax-pp.scm: Regenerated.
This commit is contained in:
Stefan Israelsson Tampe 2011-06-17 23:11:29 +02:00 • committed by Andy Wingo
parent 236f901b0e
commit 0ed9680fba
2 changed files with 2403 additions and 2366 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -2232,8 +2232,8 @@
(lambda (pattern keys) (lambda (pattern keys)
(define cvt* (define cvt*
(lambda (p* n ids) (lambda (p* n ids)
(if (null? p*) (if (not (pair? p*))
(values '() ids) (cvt p* n ids)
(call-with-values (call-with-values
(lambda () (cvt* (cdr p*) n ids)) (lambda () (cvt* (cdr p*) n ids))
(lambda (y ids) (lambda (y ids)
@ -2241,6 +2241,13 @@
(lambda () (cvt (car p*) n ids)) (lambda () (cvt (car p*) n ids))
(lambda (x ids) (lambda (x ids)
(values (cons x y) ids)))))))) (values (cons x y) ids))))))))
(define (v-reverse x)
(let loop ((r '()) (x x))
(if (not (pair? x))
(values r x)
(loop (cons (car x) r) (cdr x)))))
(define cvt (define cvt
(lambda (p n ids) (lambda (p n ids)
(if (id? p) (if (id? p)
@ -2259,15 +2266,19 @@
(lambda (p ids) (lambda (p ids)
(values (if (eq? p 'any) 'each-any (vector 'each p)) (values (if (eq? p 'any) 'each-any (vector 'each p))
ids)))) ids))))
((x dots ys ...) ((x dots . ys)
(ellipsis? (syntax dots)) (ellipsis? (syntax dots))
(call-with-values (call-with-values
(lambda () (cvt* (syntax (ys ...)) n ids)) (lambda () (cvt* (syntax ys) n ids))
(lambda (ys ids) (lambda (ys ids)
(call-with-values (call-with-values
(lambda () (cvt (syntax x) (+ n 1) ids)) (lambda () (cvt (syntax x) (+ n 1) ids))
(lambda (x ids) (lambda (x ids)
(values `#(each+ ,x ,(reverse ys) ()) ids)))))) (call-with-values
(lambda () (v-reverse ys))
(lambda (ys e)
(values `#(each+ ,x ,ys ,e)
ids))))))))
((x . y) ((x . y)
(call-with-values (call-with-values
(lambda () (cvt (syntax y) n ids)) (lambda () (cvt (syntax y) n ids))