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

bugfix

Browse Source
This commit is contained in:
Georges Dupéron 2016-09-23 00:02:04 +02:00
parent 4dc694382f
commit 0b6508958f
3 changed files with 57 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
main.rkt
View File

@ -3,6 +3,7 @@
(require generic-syntax-expanders (require generic-syntax-expanders
"private/parameters.rkt" "private/parameters.rkt"
"private/no-order.rkt" "private/no-order.rkt"
"private/before-after.rkt"
"private/pre.rkt" "private/pre.rkt"
"private/post.rkt" "private/post.rkt"
"private/global.rkt" "private/global.rkt"
@ -30,6 +31,8 @@
try-order-point> try-order-point>
~before ~before
~after ~after
~try-before
~try-after
~lift-rest ~lift-rest
~mixin ~mixin
~post-check ~post-check

54
private/before-after.rkt Normal file
View File

@ -0,0 +1,54 @@
#lang racket
(require syntax/parse
phc-toolkit/untyped
(for-syntax racket/base
syntax/parse
phc-toolkit/untyped)
"no-order.rkt"
"pre.rkt")
(provide ~before
~after
~try-before
~try-after)
(define-eh-mixin-expander ~before
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (order-point> pt other)}}])))
(define-eh-mixin-expander ~after
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (order-point< pt other)}}])))
(define-eh-mixin-expander ~try-before
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (try-order-point> pt other)}}])))
(define-eh-mixin-expander ~try-after
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (try-order-point< pt other)}}])))

43
private/no-order.rkt
View File

@ -36,8 +36,6 @@
(provide define-eh-alternative-mixin (provide define-eh-alternative-mixin
~seq-no-order ~seq-no-order
~no-order ~no-order
~before
~after
~order-point ~order-point
order-point< order-point<
order-point> order-point>
@ -274,46 +272,6 @@
(define-syntax-rule (try-order-point> a b) (define-syntax-rule (try-order-point> a b)
(if-attribute a (if-attribute b (order-point> a b) #f) #f)) (if-attribute a (if-attribute b (order-point> a b) #f) #f))
(define-eh-mixin-expander ~before
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (order-point> pt other)}}])))
(define-eh-mixin-expander ~after
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (order-point< pt other)}}])))
(define-eh-mixin-expander ~try-before
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (try-order-point> pt other)}}])))
(define-eh-mixin-expander ~try-after
(λ (stx)
(syntax-case stx ()
[(_ other message pat …)
(and (identifier? #'other)
(string? (syntax-e #'message)))
#'{~order-point pt
{~seq pat …}
{~pre-fail message #:when (try-order-point< pt other)}}])))
(define-syntax ~omitable-lifted-rest (define-syntax ~omitable-lifted-rest
(pattern-expander (pattern-expander
(λ (stx) (λ (stx)
@ -324,7 +282,6 @@
{~do 'expanded-pats} {~do 'expanded-pats}
{~bind [clause-present #t]}}])))) {~bind [clause-present #t]}}]))))
(define-eh-mixin-expander ~lift-rest (define-eh-mixin-expander ~lift-rest
(λ (stx) (λ (stx)
(syntax-case stx () (syntax-case stx ()