Renamed ~no-order to ~seq-no-order, to follow AlexKnauth's convention

This commit is contained in:
Georges Dupéron 2016-08-27 01:13:51 +02:00
parent f90e319d92
commit 7a6ff03b06
3 changed files with 54 additions and 45 deletions

View File

@ -17,7 +17,7 @@
;define-syntax-class-with-eh-mixins
define-eh-alternative-mixin
(expander-out eh-mixin)
~no-order
~seq-no-order
~post-check
~post-fail
~nop
@ -42,7 +42,7 @@
(unless (parameter-name)
(raise-syntax-error name
(string-append (symbol->string name)
" used outside of ~no-order")))
" used outside of ~seq-no-order")))
(apply (parameter-name) args))))
(define-dynamic-accumulator-parameter eh-post-accumulate eh-post-accumulate!)
@ -73,9 +73,10 @@
(apply append (stx-map inline-or #'rest))]
[x (list #'x)]))
;; TODO: ~no-order should also be a eh-mixin-expander, so that when there are
;; nested ~no-order, the ~post-fail is caught by the nearest ~no-order.
(define-syntax ~no-order
;; TODO: ~seq-no-order should also be a eh-mixin-expander, so that when there
;; are nested ~seq-no-order, the ~post-fail is caught by the nearest
;; ~seq-no-order.
(define-syntax ~seq-no-order
(pattern-expander
(λ (stx)
(syntax-case stx ()
@ -101,7 +102,9 @@
[clause-counter increment-counter])
(inline-or (expand-all-eh-mixin-expanders #'(~or pat ...)))))
(define post-group-bindings
(for/list ([group (group-by car post-groups-acc free-identifier=?)])
(for/list ([group (group-by car
post-groups-acc
free-identifier=?)])
;; each item in `group` is a four-element list:
;; (list result-id aggregate-function attribute)
(define/with-syntax name (first (car group))

View File

@ -11,46 +11,52 @@
syntax/stx
racket/format))
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~once {~global-counter [cnt 'occurrencea] #:kw}}
{~global-counter [cnt 'occurrenceb] :number}
"ab"})
(attribute cnt)])
5)
(check-equal?
(syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~seq-no-order {~once {~global-counter [cnt 'occurrencea] #:kw}}
{~global-counter [cnt 'occurrenceb] :number}
"ab"})
(attribute cnt)])
5)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~once {~global-or kw-or-number #:kw}}
{~global-or kw-or-number :number}
"ab"})
(attribute kw-or-number)])
#t)
(check-equal?
(syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~seq-no-order {~once {~global-or kw-or-number #:kw}}
{~global-or kw-or-number :number}
"ab"})
(attribute kw-or-number)])
#t)
(check-equal? (syntax-parse #'(1 "ab" "ab" 3 4 5)
[({~no-order {~optional {~global-or [kw #t] #:kw}}
{~global-or [kw #f] :number}
"ab"})
(attribute kw)])
#f)
(check-equal?
(syntax-parse #'(1 "ab" "ab" 3 4 5)
[({~seq-no-order {~optional {~global-or [kw #t] #:kw}}
{~global-or [kw #f] :number}
"ab"})
(attribute kw)])
#f)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
#f)
(check-equal?
(syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~seq-no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
#f)
(check-equal? (syntax-parse #'("ab" "ab")
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
;; (and) of nothing is #t, but we provide a 'none value
;; for this special case
'none)
(check-equal?
(syntax-parse #'("ab" "ab")
[({~seq-no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
;; (and) of nothing is #t, but we provide a 'none value
;; for this special case
'none)
(check-equal? (syntax-parse #'("ab" #:kw "ab")
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
#t)
(check-equal?
(syntax-parse #'("ab" #:kw "ab")
[({~seq-no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number}
"ab"})
(attribute kw-not-number)])
#t)

View File

@ -73,7 +73,7 @@
;; ---------
(define-splicing-syntax-class structure-kws
(pattern (~no-order (structure-kw-all-mixin))))
(pattern (~seq-no-order (structure-kw-all-mixin))))
(check-equal? (syntax-parse #'(#:instance #:? p)
[(:structure-kws)