suzanne.soy/stxparse-info
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: add ~or* and ~alt, like ~or{S,H} and ~or{EH}, respectively

Browse Source
This commit is contained in:
Ryan Culpepper 2017-06-21 18:34:36 -04:00 committed by Georges Dupéron
parent fc25ef0323
commit f238a16fbc
1 changed files with 17 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
parse/private/rep.rkt
View File

@ -106,6 +106,8 @@
(quote-syntax ~literal) (quote-syntax ~literal)
(quote-syntax ~and) (quote-syntax ~and)
(quote-syntax ~or) (quote-syntax ~or)
(quote-syntax ~or*)
(quote-syntax ~alt)
(quote-syntax ~not) (quote-syntax ~not)
(quote-syntax ~seq) (quote-syntax ~seq)
(quote-syntax ~rep) (quote-syntax ~rep)
@ -456,7 +458,7 @@
(wrong-syntax stx "action pattern not allowed here")])) (wrong-syntax stx "action pattern not allowed here")]))
(define not-shadowed? (make-not-shadowed? decls)) (define not-shadowed? (make-not-shadowed? decls))
(check-pattern (check-pattern
(syntax-case* stx (~var ~literal ~datum ~and ~or ~not ~rest ~describe (syntax-case* stx (~var ~literal ~datum ~and ~or ~or* ~alt ~not ~rest ~describe
~seq ~optional ~! ~bind ~fail ~parse ~do ~seq ~optional ~! ~bind ~fail ~parse ~do
~post ~peek ~peek-not ~delimit-cut ~commit ~reflect ~post ~peek ~peek-not ~delimit-cut ~commit ~reflect
~splicing-reflect) ~splicing-reflect)
@ -514,6 +516,11 @@
[(~or . rest) [(~or . rest)
(disappeared! stx) (disappeared! stx)
(parse-pat:or stx decls allow-head?)] (parse-pat:or stx decls allow-head?)]
[(~or* . rest)
(disappeared! stx)
(parse-pat:or stx decls allow-head?)]
[(~alt . rest)
(wrong-syntax stx "ellipsis-head pattern allowed only before ellipsis")]
[(~not . rest) [(~not . rest)
(disappeared! stx) (disappeared! stx)
(parse-pat:not stx decls)] (parse-pat:not stx decls)]
@ -622,8 +629,11 @@
(define (parse*-ellipsis-head-pattern stx decls allow-or? (define (parse*-ellipsis-head-pattern stx decls allow-or?
#:context [ctx (current-syntax-context)]) #:context [ctx (current-syntax-context)])
(define (recur stx) (parse*-ellipsis-head-pattern stx decls allow-or? #:context ctx)) (define (recur stx) (parse*-ellipsis-head-pattern stx decls allow-or? #:context ctx))
(define (recur-cdr-list stx)
(unless (stx-list? stx) (wrong-syntax stx "expected sequence of patterns"))
(apply append (map recur (cdr (stx->list stx)))))
(define not-shadowed? (make-not-shadowed? decls)) (define not-shadowed? (make-not-shadowed? decls))
(syntax-case* stx (~eh-var ~or ~between ~optional ~once) (syntax-case* stx (~eh-var ~or ~alt ~between ~optional ~once)
(make-not-shadowed-id=? decls) (make-not-shadowed-id=? decls)
[id [id
(and (identifier? #'id) (and (identifier? #'id)
@ -653,14 +663,11 @@
(replace-eh-alternative-attrs (replace-eh-alternative-attrs
alt (iattrs->sattrs iattrs))))))] alt (iattrs->sattrs iattrs))))))]
[(~or . _) [(~or . _)
allow-or?
(begin
(disappeared! stx) (disappeared! stx)
(unless (stx-list? stx) (recur-cdr-list stx)]
(wrong-syntax stx "expected sequence of patterns")) [(~alt . _)
(apply append (disappeared! stx)
(for/list ([sub (in-list (cdr (stx->list stx)))]) (recur-cdr-list stx)]
(parse*-ellipsis-head-pattern sub decls allow-or?))))]
[(~optional . _) [(~optional . _)
(disappeared! stx) (disappeared! stx)
(list (parse*-ehpat/optional stx decls))] (list (parse*-ehpat/optional stx decls))]