suzanne.soy/xlist
1
0
Fork 0
Code Issues Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Fixed {~^ power:nat} for the match expander (the . rest was missing)

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-29 17:21:30 +02:00
parent c7c2549695
commit 7465aead4c
2 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
implementation.rkt
View File

@ -285,6 +285,8 @@
(syntax-parser
#:context context
#:literals (^ * + - ∞ once)
[({~do (displayln this-syntax)} #:oops-nope)
#'trbgfdsctgbrfvdc]
[()
#'(list)]
[rest:not-stx-pair
@ -335,7 +337,7 @@
#`(list-rest-ish [] base ellipsis #,(xl #'rest))]
[(:base {~^ once} . rest)
#`(list-rest-ish [] base #|no ellipsis|# #,(xl #'rest))]
[(:base {~^ power:nat})
[(:base {~^ power:nat} . rest)
#:with occurrences (gensym 'occurrences)
#`(list-rest-ish [(? (λ (_) (= (length occurrences) power)))]
(and occurrences base) ooo

12
test/test-match.rkt
View File

@ -200,9 +200,9 @@
(void))
(test-begin
"{once}, {1} and a simple pattern variable"
(check-match '(a a a a a a a a)
[(xlist a1 ^ {once} a2 ^ {1} a3 a4 ^ *)
(list a4 a3 a2 a1)]
'((a a a a a) a (a) a))
(void))
"{once}, {1} and a simple pattern variable"
(check-match '(a a a a a a a a)
[(xlist a1 ^ {once} a2 ^ {1} a3 a4 ^ *)
(list a4 a3 a2 a1)]
'((a a a a a) a (a) a))
(void))