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

Preemptive bugfix

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-23 00:31:08 +02:00
parent 0b6508958f
commit 354794a185
2 changed files with 19 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
private/before-after.rkt
View File

@ -6,7 +6,8 @@
syntax/parse syntax/parse
phc-toolkit/untyped) phc-toolkit/untyped)
"no-order.rkt" "no-order.rkt"
"pre.rkt") "pre.rkt"
"parameters.rkt")
(provide ~before (provide ~before
~after ~after
@ -19,9 +20,10 @@
[(_ other message pat …) [(_ other message pat …)
(and (identifier? #'other) (and (identifier? #'other)
(string? (syntax-e #'message))) (string? (syntax-e #'message)))
(with-syntax ([pt (get-new-clause!)])
#'{~order-point pt #'{~order-point pt
{~seq pat …} {~seq pat …}
{~pre-fail message #:when (order-point> pt other)}}]))) {~pre-fail message #:when (order-point> pt other)}})])))
(define-eh-mixin-expander ~after (define-eh-mixin-expander ~after
(λ (stx) (λ (stx)
@ -29,9 +31,10 @@
[(_ other message pat …) [(_ other message pat …)
(and (identifier? #'other) (and (identifier? #'other)
(string? (syntax-e #'message))) (string? (syntax-e #'message)))
(with-syntax ([pt (get-new-clause!)])
#'{~order-point pt #'{~order-point pt
{~seq pat …} {~seq pat …}
{~pre-fail message #:when (order-point< pt other)}}]))) {~pre-fail message #:when (order-point< pt other)}})])))
(define-eh-mixin-expander ~try-before (define-eh-mixin-expander ~try-before
(λ (stx) (λ (stx)
@ -39,9 +42,10 @@
[(_ other message pat …) [(_ other message pat …)
(and (identifier? #'other) (and (identifier? #'other)
(string? (syntax-e #'message))) (string? (syntax-e #'message)))
(with-syntax ([pt (get-new-clause!)])
#'{~order-point pt #'{~order-point pt
{~seq pat …} {~seq pat …}
{~pre-fail message #:when (try-order-point> pt other)}}]))) {~pre-fail message #:when (try-order-point> pt other)}})])))
(define-eh-mixin-expander ~try-after (define-eh-mixin-expander ~try-after
(λ (stx) (λ (stx)
@ -49,6 +53,7 @@
[(_ other message pat …) [(_ other message pat …)
(and (identifier? #'other) (and (identifier? #'other)
(string? (syntax-e #'message))) (string? (syntax-e #'message)))
(with-syntax ([pt (get-new-clause!)])
#'{~order-point pt #'{~order-point pt
{~seq pat …} {~seq pat …}
{~pre-fail message #:when (try-order-point< pt other)}}]))) {~pre-fail message #:when (try-order-point< pt other)}})])))

2
private/no-order.rkt
View File

@ -216,7 +216,7 @@
1) 1)
(string-append "more than one of the lifted rest" (string-append "more than one of the lifted rest"
" patterns matched")})))) " patterns matched")}))))
((λ (x) #;(pretty-write (syntax->datum x)) x) ((λ (x) (pretty-write (syntax->datum x)) x)
#`(~delimit-cut #`(~delimit-cut
(~and #,(fix-disappeared-uses) (~and #,(fix-disappeared-uses)
whole-clause-pat whole-clause-pat