Made ~order-point work with possibly-empty clauses.
This commit is contained in:
parent
6803336145
commit
66726ba26e
|
@ -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
42
test/test-maybe-empty.rkt
Normal 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))
|
Loading…
Reference in New Issue
Block a user