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

syntax/parse: allow zero syntax-parse clauses and zero syntax-class variants

Browse Source
This commit is contained in:
Ryan Culpepper 2011-03-03 15:33:14 -07:00
parent d0d2285c4c
commit 1353d40612
2 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/syntax/parse/private/parse.rkt
View File

@ -124,6 +124,9 @@ Conventions:
;; (parse:variants x cx relsattrs variants splicing? pr es success cp0) : expr[Ans]
(define-syntax (parse:variants stx)
(syntax-case stx ()
[(parse:variants x cx relsattrs () splicing? pr es success cp0 commit?)
;; Special case: no variants
#'(fail (failure pr es))]
[(parse:variants x cx relsattrs (variant ...) splicing? pr es success cp0 commit?)
#'(try (parse:variant x cx relsattrs variant splicing? pr es success cp0 commit?) ...)]))
@ -208,11 +211,14 @@ Conventions:
#`(let ()
local-def ...
(parse:S x cx pattern pr es (let () . rest)))))]))
(unless (and (stx-list? clauses-stx) (stx-pair? clauses-stx))
(raise-syntax-error #f "expected non-empty sequence of clauses" #'ctx))
(unless (stx-list? clauses-stx)
(raise-syntax-error #f "expected sequence of clauses" #'ctx))
(define alternatives
(if (stx-pair? clauses-stx)
(map for-clause (stx->list clauses-stx))
(list #`(fail (failure pr es)))))
(with-syntax ([(def ...) (append (get-txlifts-as-definitions) defs)]
[(alternative ...)
(map for-clause (stx->list clauses-stx))])
[(alternative ...) alternatives])
#`(let* ([ctx0 #,context]
[pr (ps-empty x ctx0)]
[es null]
@ -288,14 +294,14 @@ Conventions:
#`(let ([d (if (syntax? x) (syntax-e x) x)])
(if (equal? d (quote datum))
k
(fail (failure pr (cons(expect:atom 'datum) es)))))]
(fail (failure pr (cons (expect:atom 'datum) es)))))]
[#s(pat:literal attrs literal input-phase lit-phase)
#`(if (and (identifier? x)
(free-identifier=?/phases
x input-phase
(quote-syntax literal) lit-phase))
k
(fail (failure pr (cons(expect:literal (quote-syntax literal)) es))))]
(fail (failure pr (cons (expect:literal (quote-syntax literal)) es))))]
[#s(pat:action attrs action subpattern)
#'(parse:A x cx action pr es (parse:S x cx subpattern pr es k))]
[#s(pat:head attrs head tail)

2
collects/syntax/parse/private/rep.rkt
View File

@ -168,8 +168,6 @@
[auto-nested? 'try]
[else 'no])))
(parse-variants rest decls splicing? expected-attrs)))
(when (null? variants)
(wrong-syntax #f "expected at least one variant"))
(let ([sattrs
(or attributes
(intersect-sattrss (map variant-attrs variants)))])