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

Added eh-first-accumulate, fixed the behaviour of ~maybe/empty and ~named-seq by using it.

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-23 17:06:29 +02:00
parent 54d3b54230
commit 4f7e3353d1
3 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
private/no-order.rkt
View File

@ -43,7 +43,7 @@
try-order-point> try-order-point>
~lift-rest ~lift-rest
~omitable-lifted-rest ;; Private ~omitable-lifted-rest ;; Private
(expander-out eh-mixin)) (expander-out eh-mixin)) ;; Private
(define-expander-type eh-mixin) (define-expander-type eh-mixin)
@ -124,8 +124,10 @@
(define (increment-counter!) (define (increment-counter!)
(begin0 counter (begin0 counter
(set! counter (add1 counter)))) (set! counter (add1 counter))))
;; pre-acc and post-acc gather some a-patterns which will be added after ;; first, pre and post-acc gather a-patterns which will be added after
;; the (~seq (~or ) ...), before and after the ~! cut respectively ;; the (~seq (~or ) ...), before and after the ~! cut respectively
(define first-acc '())
(define (add-to-first! v) (set! first-acc (cons v first-acc)))
(define pre-acc '()) (define pre-acc '())
(define (add-to-pre! v) (set! pre-acc (cons v pre-acc))) (define (add-to-pre! v) (set! pre-acc (cons v pre-acc)))
(define post-acc '()) (define post-acc '())
@ -142,7 +144,8 @@
succeeded-clause) succeeded-clause)
lifted-rest))) lifted-rest)))
;; expand EH alternatives: ;; expand EH alternatives:
(parameterize ([eh-pre-accumulate add-to-post!] (parameterize ([eh-first-accumulate add-to-first!]
[eh-pre-accumulate add-to-pre!]
[eh-post-group add-to-post-groups!] [eh-post-group add-to-post-groups!]
[eh-post-accumulate add-to-post!] [eh-post-accumulate add-to-post!]
[clause-counter increment-counter!] [clause-counter increment-counter!]
@ -221,7 +224,7 @@
1) 1)
(string-append "more than one of the lifted rest" (string-append "more than one of the lifted rest"
" patterns matched")})))) " patterns matched")}))))
((λ (x) #;(pretty-write (syntax->datum x)) x) ((λ (x) #;(pretty-write (syntax->datum #`(syntax-parser [#,x 'ok]))) x)
#`(~delimit-cut #`(~delimit-cut
(~and #,(fix-disappeared-uses) (~and #,(fix-disappeared-uses)
whole-clause-pat whole-clause-pat
@ -237,6 +240,7 @@
(syntax-property xi (syntax-property xi
parse-seq-order-sym-id parse-seq-order-sym-id
i))} i))}
#,@(reverse first-acc)
#,@(reverse pre-acc) #,@(reverse pre-acc)
#,@caught-omitable-lifted-rest #,@caught-omitable-lifted-rest
#,@rest-handlers #,@rest-handlers

5
private/parameters.rkt
View File

@ -2,7 +2,9 @@
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide (for-syntax eh-pre-accumulate (provide (for-syntax eh-first-accumulate
eh-first-accumulate!
eh-pre-accumulate
eh-pre-accumulate! eh-pre-accumulate!
eh-post-accumulate eh-post-accumulate
eh-post-accumulate! eh-post-accumulate!
@ -24,6 +26,7 @@
" used outside of ~seq-no-order"))) " used outside of ~seq-no-order")))
(apply (parameter-name) args)))) (apply (parameter-name) args))))
(define-dynamic-accumulator-parameter eh-first-accumulate eh-first-accumulate!)
(define-dynamic-accumulator-parameter eh-pre-accumulate eh-pre-accumulate!) (define-dynamic-accumulator-parameter eh-pre-accumulate eh-pre-accumulate!)
(define-dynamic-accumulator-parameter eh-post-group eh-post-group!) (define-dynamic-accumulator-parameter eh-post-group eh-post-group!)
(define-dynamic-accumulator-parameter eh-post-accumulate eh-post-accumulate!) (define-dynamic-accumulator-parameter eh-post-accumulate eh-post-accumulate!)

14
private/pre.rkt
View File

@ -43,6 +43,7 @@
(define-eh-mixin-expander ~pre-fail pre-fail) (define-eh-mixin-expander ~pre-fail pre-fail)
;; TODO: fixme: should happen before the other pre operations
(define-eh-mixin-expander ~named-seq (define-eh-mixin-expander ~named-seq
(λ (stx) (λ (stx)
(syntax-case stx () (syntax-case stx ()
@ -51,7 +52,7 @@
(let () (let ()
(define/with-syntax clause-present (get-new-clause!)) (define/with-syntax clause-present (get-new-clause!))
(define/with-syntax clause (get-new-clause!)) (define/with-syntax clause (get-new-clause!))
(eh-pre-accumulate! '~named-seq (eh-first-accumulate! '~named-seq
#'(~bind [(id 1) (if (attribute clause-present) #'(~bind [(id 1) (if (attribute clause-present)
(attribute clause) (attribute clause)
(list))])) (list))]))
@ -59,14 +60,19 @@
(~seq clause (... ...)) (~seq clause (... ...))
(~seq . pats)))]))) (~seq . pats)))])))
;; TODO: fixme: should happen before the other pre operations
(define-eh-mixin-expander ~maybe/empty (define-eh-mixin-expander ~maybe/empty
(λ (stx) (λ (stx)
(syntax-case stx () (syntax-case stx ()
[(_ . pats) [(_ pat …)
(let () (let ()
(define/with-syntax clause-present (get-new-clause!)) (define/with-syntax clause-present (get-new-clause!))
(eh-pre-accumulate! '~maybe/empty (define/with-syntax (expanded-pat …)
#'(~parse {~no-order {~seq . pats}} ;; let the ~post, ~global etc. within pat … be recognized
(expand-all-eh-mixin-expanders #'(pat …)))
(eh-first-accumulate! '~maybe/empty
#'(~parse (expanded-pat …)
#'(clause (... ...)))) #'(clause (... ...))))
#'{~optional {~and {~bind [clause-present #t]} #'{~optional {~and {~bind [clause-present #t]}
{~seq clause (... ...)}}})]))) {~seq clause (... ...)}}})])))