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

Fixed ^ {once} for the match expander

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-29 16:28:18 +02:00
parent 76c9e89b20
commit c7c2549695
3 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
implementation.rkt
View File

@ -264,9 +264,7 @@
(nt #'(base ^ from - ∞ . rest))] (nt #'(base ^ from - ∞ . rest))]
[(:base {~^ power:nat} . rest) [(:base {~^ power:nat} . rest)
#`(base ^ {power} . #,(nt #'rest))] #`(base ^ {power} . #,(nt #'rest))]
[(:base {~^ once} . rest) [(:base {~optional {~^ once}} . rest)
#`(base ^ {once} . #,(nt #'rest))]
[(:base . rest)
#`(base ^ {once} . #,(nt #'rest))])) #`(base ^ {once} . #,(nt #'rest))]))
(nt stx)) (nt stx))
@ -286,7 +284,7 @@
(define xl (define xl
(syntax-parser (syntax-parser
#:context context #:context context
#:literals (^ * + - ∞) #:literals (^ * + - ∞ once)
[() [()
#'(list)] #'(list)]
[rest:not-stx-pair [rest:not-stx-pair
@ -335,8 +333,8 @@
#:when (regexp-match? #px"^\\.\\.[0-9]+$" #:when (regexp-match? #px"^\\.\\.[0-9]+$"
(symbol->string (syntax-e #'ellipsis))) (symbol->string (syntax-e #'ellipsis)))
#`(list-rest-ish [] base ellipsis #,(xl #'rest))] #`(list-rest-ish [] base ellipsis #,(xl #'rest))]
[(:base {~^ once}) [(:base {~^ once} . rest)
#`(list-rest-ish [] base #|no ellipsis|# . #,(xl #'rest))] #`(list-rest-ish [] base #|no ellipsis|# #,(xl #'rest))]
[(:base {~^ power:nat}) [(:base {~^ power:nat})
#:with occurrences (gensym 'occurrences) #:with occurrences (gensym 'occurrences)
#`(list-rest-ish [(? (λ (_) (= (length occurrences) power)))] #`(list-rest-ish [(? (λ (_) (= (length occurrences) power)))]

15
scribblings/split-xlist.scrbl
View File

@ -1,11 +1,15 @@
#lang scribble/manual #lang scribble/manual
@require[phc-toolkit/scribblings/utils @require[phc-toolkit/scribblings/utils
scribble/examples
@for-label[xlist @for-label[xlist
typed/racket/base]] typed/racket/base]]
@title{Splitting an xlist in its constituent sublists} @title{Splitting an xlist in its constituent sublists}
@(declare-exporting xlist) @(declare-exporting xlist)
@(define make-eval (make-eval-factory '(xlist)
#:lang 'typed/racket))
@defform*[#:kind "match-expander" @defform*[#:kind "match-expander"
#:literals (^ * + - ∞) #:literals (^ * + - ∞)
[(split-xlist pat τᵢ ...) [(split-xlist pat τᵢ ...)
@ -52,4 +56,13 @@
equivalent, the type of the sublist will be @racket[(xList type ^ _n)]} equivalent, the type of the sublist will be @racket[(xList type ^ _n)]}
@item{If the @racket[_repeat] for that element is @racket[_from - _to] or an @item{If the @racket[_repeat] for that element is @racket[_from - _to] or an
equivalent, the type of the sublist will be equivalent, the type of the sublist will be
@racket[(xList type ^ _from - _to)]}]} @racket[(xList type ^ _from - _to)]}
@item{The @racket[#:rest] or dotted rest is included as the last element of
the list matched against @racket[pat]. If the first form without a rest type
is used, the list matched against @racket[pat] still contains @racket['()] as
a last element:
@examples[#:eval (make-eval)
(match '(1 2 3)
[(split-xlist (list (list a) (list b c) (? null?))
Number¹ Number⃰)
(vector c b a)])]}]}

8
test/test-match.rkt
View File

@ -198,3 +198,11 @@
(list n2 s n1)] (list n2 s n1)]
'((7 8 9) (d e f) (1 2 3))) '((7 8 9) (d e f) (1 2 3)))
(void)) (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))