www

commit 66726ba26e7d318478e3c0fa6ac833e60baa9ad8
parent 6803336145db87d18fc9a18877cb0d209a7b0f67
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Wed, 28 Sep 2016 14:01:25 +0200

Made ~order-point work with possibly-empty clauses.

Diffstat:
M
private/no-order.rkt
 | 
12
++++++++----
A
test/test-maybe-empty.rkt
 | 
43
+++++++++++++++++++++++++++++++++++++++++++

2 files changed, 51 insertions(+), 4 deletions(-)
diff --git a/private/no-order.rkt b/private/no-order.rkt
@@ -260,10 +260,14 @@
                      'parse-seq-order-sym))
     (syntax-case stx ()
       [(_ point-name pat …)
-       #'(~and (~seq clause-point _ (… …))
-               (~bind [point-name (syntax-property #'clause-point
-                                                   parse-seq-order-sym-id)])
-               {~seq pat …})])))
+       #'{~and {~seq pat …}
+               {~either {~and {~seq clause-point _ (… …)}
+                              {~bind
+                               [point-name
+                                (syntax-property #'clause-point
+                                                 parse-seq-order-sym-id)]}}
+                        {~and {~seq}
+                              {~bind [point-name #f]}}}}])))
 
 (define-syntax-rule (order-point< a b)
   (and (attribute a) (attribute b)
diff --git a/test/test-maybe-empty.rkt b/test/test-maybe-empty.rkt
@@ -0,0 +1,42 @@
+#lang racket
+
+(require extensible-parser-specifications
+         racket/require
+         syntax/parse
+         (subtract-in syntax/stx phc-toolkit/untyped)
+         rackunit
+         racket/format
+         phc-toolkit/untyped
+         (for-syntax syntax/parse
+                     syntax/stx
+                     racket/format))
+
+(check-equal? (syntax-parse #'()
+   [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+    (syntax->datum #'(#:rest τ-rest #:τᵢ τᵢ …))])
+ '(#:rest () #:τᵢ))
+
+(check-equal? (syntax-parse #'a
+                 [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+                  (syntax->datum #'(τ-rest τᵢ …))])
+              '(#:rest a #:τᵢ))
+
+(check-equal? (syntax-parse #'(a)
+                 [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+                  (syntax->datum #'(τ-rest τᵢ …))])
+              '(#:rest () #:τᵢ a))
+
+(check-equal? (syntax-parse #'(a . b)
+                 [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+                  (syntax->datum #'(τ-rest τᵢ …))])
+              '(#:rest b #:τᵢ a))
+
+(check-equal? (syntax-parse #'(a b)
+                 [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+                  (syntax->datum #'(τ-rest τᵢ …))])
+              '(#:rest () #:τᵢ a b))
+
+(check-equal? (syntax-parse #'(a b . c)
+                 [{~no-order (~maybe/empty {~seq τᵢ ... {~lift-rest τ-rest}})}
+                  (syntax->datum #'(τ-rest τᵢ …))])
+              '(#:rest c #:τᵢ a b))
+\ No newline at end of file