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

Fixed ~maybe/empty

Browse Source
This commit is contained in:
Georges Dupéron 2016-10-01 00:16:17 +02:00
parent 365fed9872
commit d68aa79984
1 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
private/pre.rkt
View File

@ -63,18 +63,19 @@
;; TODO: fixme: should happen before the other pre operations
(define-eh-mixin-expander ~maybe/empty
(λ (stx)
(syntax-case stx ()
[(_ pat …)
(let ()
(define/with-syntax clause-present (get-new-clause!))
(define/with-syntax (expanded-pat …)
;; let the ~post, ~global etc. within pat … be recognized
(expand-all-eh-mixin-expanders #'(pat …)))
(eh-first-accumulate! '~maybe/empty
#'(~parse (expanded-pat …)
(if (attribute clause)
#'(clause (... ...))
#'())))
#'{~optional {~and {~bind [clause-present #t]}
{~seq clause (... ...)}}})])))
(syntax-parser
[(_ {~and pat {~not #:name}} …
{~optional {~seq #:name name}})
(let ()
(define/with-syntax clause-present (get-new-clause!))
(define/with-syntax (expanded-pat …)
;; let the ~post, ~global etc. within pat … be recognized
(expand-all-eh-mixin-expanders #'(pat …)))
(eh-first-accumulate! '~maybe/empty
#'(~parse (expanded-pat …)
(if (attribute clause)
#'(clause (... ...))
#'())))
#`{~optional {~and {~bind [clause-present #t]}
{~seq clause (... ...)}}
#,@(when-attr name #'(#:name name))})]))