d7a87c79e0
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)
111 lines
2.7 KiB
Racket
111 lines
2.7 KiB
Racket
#lang scheme
|
|
(require rackunit
|
|
syntax/parse)
|
|
(require (for-syntax syntax/parse))
|
|
(provide (all-defined-out))
|
|
|
|
;; Error selection tests
|
|
|
|
(error-print-source-location #f)
|
|
|
|
(define-syntax-rule (terx s p stuff ...)
|
|
(terx* s [p] stuff ...))
|
|
|
|
(define-syntax terx*
|
|
(syntax-parser
|
|
[(terx s [p ...] (~optional (~seq #:term term) #:defaults ([term #'#f])) rx ...)
|
|
#'(test-case (format "line ~s: ~a match ~s for error"
|
|
(syntax-line (quote-syntax s))
|
|
's '(p ...))
|
|
(let ([exn (let/ec escape
|
|
(check-exn (lambda (exn)
|
|
(escape exn))
|
|
(lambda ()
|
|
(syntax-parse (quote-syntax s)
|
|
[p (void)] ...))))])
|
|
(let ([msg (exn-message exn)]
|
|
[stxs (and (exn:fail:syntax? exn)
|
|
(exn:fail:syntax-exprs exn))])
|
|
(when 'term
|
|
(check-equal? (and (pair? stxs) (syntax->datum (car stxs))) 'term))
|
|
(erx rx (exn-message exn)) ... #t))
|
|
(void))]))
|
|
|
|
(define-syntax erx
|
|
(syntax-rules (not)
|
|
[(erx (not rx) msg)
|
|
(check (compose not regexp-match?) rx msg)]
|
|
[(erx rx msg)
|
|
(check regexp-match? rx msg)]))
|
|
|
|
;; ----
|
|
|
|
(terx (a b c 7) (x:id ...)
|
|
#:term 7
|
|
#rx"expected identifier")
|
|
|
|
;; ----
|
|
|
|
(terx* (1 2) [x:nat (y:id z:id)]
|
|
#:term 1
|
|
#rx"expected identifier")
|
|
|
|
;; --
|
|
|
|
(define-syntax-class bindings
|
|
(pattern ((var:id rhs:expr) ...)))
|
|
|
|
(terx* ((x 1 2)) [x:id bs:bindings]
|
|
#:term 2
|
|
#rx"unexpected term")
|
|
|
|
;; --
|
|
|
|
(terx ((a 1) (a 2))
|
|
((~or (~once ((~datum a) x) #:name "A clause")
|
|
(~optional ((~datum b) y) #:name "B clause"))
|
|
...)
|
|
;; #:term (a 2)
|
|
#rx"too many occurrences of A clause")
|
|
|
|
;; --
|
|
|
|
(define-syntax-class A
|
|
(pattern ((~datum a) x)))
|
|
(define-syntax-class B
|
|
(pattern ((~datum b) y)))
|
|
|
|
(terx ((a 1) (a 2))
|
|
((~or (~once a:A #:name "A clause")
|
|
(~optional b:B #:name "B clause"))
|
|
...)
|
|
#rx"too many occurrences of A clause")
|
|
|
|
(terx ((a 1 2) _)
|
|
((~or (~once a:A #:name "A clause")
|
|
(~optional b:B #:name "B clause"))
|
|
...)
|
|
#rx"unexpected term")
|
|
|
|
(terx ((b 1 2) _)
|
|
((~or (~once a:A #:name "A clause")
|
|
(~optional b:B #:name "B clause"))
|
|
...)
|
|
#rx"unexpected term")
|
|
|
|
;; Ellipses
|
|
|
|
(terx (a b c 4)
|
|
(x:id ...)
|
|
#rx"expected identifier")
|
|
|
|
;; Repetition constraints
|
|
|
|
(terx (1 2)
|
|
((~or (~once x:id #:name "identifier") n:nat) ...)
|
|
#rx"missing required occurrence of identifier")
|
|
|
|
(terx (1 a 2 b)
|
|
((~or (~once x:id #:name "identifier") n:nat) ...)
|
|
#rx"too many occurrences of identifier")
|