suzanne.soy/extensible-parser-specifications
1
0
Fork 0
Code Issues 2 Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
main.rkt
View File

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

30
test/test-global.rkt
View File

@ -11,36 +11,41 @@
syntax/stx syntax/stx
racket/format)) racket/format))
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal?
[({~no-order {~once {~global-counter [cnt 'occurrencea] #:kw}} (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5)
[({~seq-no-order {~once {~global-counter [cnt 'occurrencea] #:kw}}
{~global-counter [cnt 'occurrenceb] :number} {~global-counter [cnt 'occurrenceb] :number}
"ab"}) "ab"})
(attribute cnt)]) (attribute cnt)])
5) 5)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal?
[({~no-order {~once {~global-or kw-or-number #:kw}} (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} {~global-or kw-or-number :number}
"ab"}) "ab"})
(attribute kw-or-number)]) (attribute kw-or-number)])
#t) #t)
(check-equal? (syntax-parse #'(1 "ab" "ab" 3 4 5) (check-equal?
[({~no-order {~optional {~global-or [kw #t] #:kw}} (syntax-parse #'(1 "ab" "ab" 3 4 5)
[({~seq-no-order {~optional {~global-or [kw #t] #:kw}}
{~global-or [kw #f] :number} {~global-or [kw #f] :number}
"ab"}) "ab"})
(attribute kw)]) (attribute kw)])
#f) #f)
(check-equal? (syntax-parse #'(1 "ab" #:kw "ab" 3 4 5) (check-equal?
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}} (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} {~global-and [kw-not-number #f] :number}
"ab"}) "ab"})
(attribute kw-not-number)]) (attribute kw-not-number)])
#f) #f)
(check-equal? (syntax-parse #'("ab" "ab") (check-equal?
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}} (syntax-parse #'("ab" "ab")
[({~seq-no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number} {~global-and [kw-not-number #f] :number}
"ab"}) "ab"})
(attribute kw-not-number)]) (attribute kw-not-number)])
@ -48,8 +53,9 @@
;; for this special case ;; for this special case
'none) 'none)
(check-equal? (syntax-parse #'("ab" #:kw "ab") (check-equal?
[({~no-order {~optional {~global-and [kw-not-number #t] #:kw}} (syntax-parse #'("ab" #:kw "ab")
[({~seq-no-order {~optional {~global-and [kw-not-number #t] #:kw}}
{~global-and [kw-not-number #f] :number} {~global-and [kw-not-number #f] :number}
"ab"}) "ab"})
(attribute kw-not-number)]) (attribute kw-not-number)])

2
test/test-structure-options.rkt
View File

@ -73,7 +73,7 @@
;; --------- ;; ---------
(define-splicing-syntax-class structure-kws (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) (check-equal? (syntax-parse #'(#:instance #:? p)
[(:structure-kws) [(:structure-kws)