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

This commit is contained in:
Georges Dupéron 2016-09-28 14:01:25 +02:00
parent 6803336145
commit 66726ba26e
2 changed files with 50 additions and 4 deletions

View File

@ -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)

42
test/test-maybe-empty.rkt Normal file
View File

@ -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))