
Changed backtracking algorithm, runtime representations - syntax classes, ~describe no longer implicitly commit - ~describe no longer delimits effect of cut Added keyword & optional args for stxclasses Added ~do and #:do, ~post, ~commit and #:commit, ~delimit-cut and #:no-delimit-cut Added syntax/parse/debug, syntax/parse/experimental/* - expr/c for contracting macro sub-expressions moved from syntax/parse to syntax/parse/experimental/contract - syntax class reflection (~reflect, ~splicing-reflect) - eh-alternative-sets (~eh-var) - provide-syntax-class/contract (only for params, not attrs so far) Changed ~fail to not include POST progress (#:fail still does) old (~fail _) is now (~post (~fail _)) Made msg argument of ~fail optional Removed generic "repetition constraint violated" msg Removed atom-in-list stxclass Removed unnecessary datum->syntax on cdr of pair pattern massive improvements to long-list microbenchmarks Optimization: integrable syntax classes (id, expr, keyword) need better measurements Optimization: ad hoc elimination of head/tail choice point for (EH ... . ()) patterns Added unstable/wrapc (proc version of expr/c)
79 lines
4.1 KiB
Racket
79 lines
4.1 KiB
Racket
#lang racket/base
|
|
(require (for-syntax racket/base
|
|
syntax/parse
|
|
unstable/syntax
|
|
"../private/minimatch.rkt"
|
|
"../private/rep.rkt"
|
|
"../private/rep-data.rkt"
|
|
"../private/rep-patterns.rkt"
|
|
"../private/kws.rkt")
|
|
"../private/keywords.rkt"
|
|
"../private/sc.rkt")
|
|
|
|
(provide ~eh-var
|
|
define-eh-alternative-set)
|
|
|
|
(define-syntax (define-eh-alternative-set stx)
|
|
(define-syntax-class alt
|
|
#:description "eh-alternate-set alternative"
|
|
#:literals (pattern)
|
|
(pattern (pattern alt)))
|
|
(syntax-parse stx
|
|
#:literals (pattern)
|
|
[(_ name:id a:alt ...)
|
|
(parameterize ((current-syntax-context stx))
|
|
(let* ([decls (new-declenv null #:conventions null)]
|
|
[ehpat+hstx-list
|
|
(apply append
|
|
(for/list ([alt (in-list (syntax->list #'(a.alt ...)))])
|
|
(parse*-ellipsis-head-pattern alt decls #t #:context stx)))]
|
|
[eh-alt+defs-list
|
|
(for/list ([ehpat+hstx (in-list ehpat+hstx-list)])
|
|
(let ([ehpat (car ehpat+hstx)]
|
|
[hstx (cadr ehpat+hstx)])
|
|
(cond [(syntax? hstx)
|
|
(with-syntax ([(parser) (generate-temporaries '(eh-alt-parser))])
|
|
(let ([attrs (iattrs->sattrs (pattern-attrs (ehpat-head ehpat)))])
|
|
(list (eh-alternative (ehpat-repc ehpat) attrs #'parser)
|
|
(list #`(define parser
|
|
(parser/rhs parser () #,attrs
|
|
[#:description #f (pattern #,hstx)]
|
|
#t
|
|
#,stx))))))]
|
|
[(eh-alternative? hstx)
|
|
(list hstx null)]
|
|
[else
|
|
(error 'define-eh-alternative-set "internal error: unexpected ~e"
|
|
hstx)])))]
|
|
[eh-alts (map car eh-alt+defs-list)]
|
|
[defs (apply append (map cadr eh-alt+defs-list))])
|
|
(with-syntax ([(def ...) defs]
|
|
[(alt-expr ...)
|
|
(for/list ([alt (in-list eh-alts)])
|
|
(with-syntax ([repc-expr
|
|
(match (eh-alternative-repc alt)
|
|
['#f
|
|
#'(quote #f)]
|
|
[(rep:once n u o)
|
|
#`(rep:once (quote-syntax #,n)
|
|
(quote-syntax #,u)
|
|
(quote-syntax #,o))]
|
|
[(rep:optional n o d)
|
|
#`(rep:optional (quote-syntax #,n)
|
|
(quote-syntax #,o)
|
|
(quote-syntax #,d))]
|
|
[(rep:bounds min max n u o)
|
|
#`(rep:bounds (quote #,min)
|
|
(quote #,max)
|
|
(quote-syntax #,n)
|
|
(quote-syntax #,u)
|
|
(quote-syntax #,o))])]
|
|
[attrs-expr
|
|
#`(quote #,(eh-alternative-attrs alt))]
|
|
[parser-expr
|
|
#`(quote-syntax #,(eh-alternative-parser alt))])
|
|
#'(eh-alternative repc-expr attrs-expr parser-expr)))])
|
|
#'(begin def ...
|
|
(define-syntax name
|
|
(eh-alternative-set (list alt-expr ...)))))))]))
|