From c7c254969563d375c18e81745d45deb3c41fb91c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Thu, 29 Sep 2016 16:28:18 +0200
Subject: [PATCH] Fixed ^ {once} for the match expander

---
 implementation.rkt            | 12 +++++-------
 scribblings/split-xlist.scrbl | 15 ++++++++++++++-
 test/test-match.rkt           |  8 ++++++++
 3 files changed, 27 insertions(+), 8 deletions(-)

diff --git a/implementation.rkt b/implementation.rkt
index 88205e8..6974b0d 100644
--- a/implementation.rkt
+++ b/implementation.rkt
@@ -264,10 +264,8 @@
            (nt #'(base ^ from - ∞ . rest))]
           [(:base {~^ power:nat} . rest)
            #`(base ^ {power} . #,(nt #'rest))]
-          [(:base {~^ once} . rest)
-           #`(base ^ {once} . #,(nt #'rest))]
-          [(:base . rest)
-             #`(base ^ {once} . #,(nt #'rest))]))
+          [(:base {~optional {~^ once}} . rest)
+           #`(base ^ {once} . #,(nt #'rest))]))
       (nt stx))
 
 
@@ -286,7 +284,7 @@
       (define xl
         (syntax-parser
           #:context context
-          #:literals (^ * + - ∞)
+          #:literals (^ * + - ∞ once)
           [()
            #'(list)]
           [rest:not-stx-pair
@@ -335,8 +333,8 @@
            #:when (regexp-match? #px"^\\.\\.[0-9]+$"
                                  (symbol->string (syntax-e #'ellipsis)))
            #`(list-rest-ish [] base ellipsis #,(xl #'rest))]
-          [(:base {~^ once})
-           #`(list-rest-ish [] base #|no ellipsis|# . #,(xl #'rest))]
+          [(:base {~^ once} . rest)
+           #`(list-rest-ish [] base #|no ellipsis|# #,(xl #'rest))]
           [(:base {~^ power:nat})
            #:with occurrences (gensym 'occurrences)
            #`(list-rest-ish [(? (λ (_) (= (length occurrences) power)))]
diff --git a/scribblings/split-xlist.scrbl b/scribblings/split-xlist.scrbl
index 1d133f3..eae54a5 100644
--- a/scribblings/split-xlist.scrbl
+++ b/scribblings/split-xlist.scrbl
@@ -1,11 +1,15 @@
 #lang scribble/manual
 @require[phc-toolkit/scribblings/utils
+         scribble/examples
          @for-label[xlist
                     typed/racket/base]]
 
 @title{Splitting an xlist in its constituent sublists}
 @(declare-exporting xlist)
 
+@(define make-eval (make-eval-factory '(xlist)
+                                      #:lang 'typed/racket))
+
 @defform*[#:kind "match-expander"
           #:literals (^ * + - ∞)
           [(split-xlist pat τᵢ ...)
@@ -52,4 +56,13 @@
    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
    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)])]}]}
diff --git a/test/test-match.rkt b/test/test-match.rkt
index c28908b..3260855 100644
--- a/test/test-match.rkt
+++ b/test/test-match.rkt
@@ -198,3 +198,11 @@
                (list n2 s n1)]
               '((7 8 9) (d e f) (1 2 3)))
  (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))