mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +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

4748
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)
(define cvt*
(lambda (p* n ids)
(if (null? p*)
(values '() ids)
(if (not (pair? p*))
(cvt p* n ids)
(call-with-values
(lambda () (cvt* (cdr p*) n ids))
(lambda (y ids)
@ -2241,6 +2241,13 @@
(lambda () (cvt (car p*) n ids))
(lambda (x 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
(lambda (p n ids)
(if (id? p)
@ -2259,15 +2266,19 @@
(lambda (p ids)
(values (if (eq? p 'any) 'each-any (vector 'each p))
ids))))
((x dots ys ...)
((x dots . ys)
(ellipsis? (syntax dots))
(call-with-values
(lambda () (cvt* (syntax (ys ...)) n ids))
(lambda () (cvt* (syntax ys) n ids))
(lambda (ys ids)
(call-with-values
(lambda () (cvt (syntax x) (+ n 1) 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)
(call-with-values
(lambda () (cvt (syntax y) n ids))