bugfix
This commit is contained in:
parent
4dc694382f
commit
0b6508958f
3
main.rkt
3
main.rkt
|
@ -3,6 +3,7 @@
|
|||
(require generic-syntax-expanders
|
||||
"private/parameters.rkt"
|
||||
"private/no-order.rkt"
|
||||
"private/before-after.rkt"
|
||||
"private/pre.rkt"
|
||||
"private/post.rkt"
|
||||
"private/global.rkt"
|
||||
|
@ -30,6 +31,8 @@
|
|||
try-order-point>
|
||||
~before
|
||||
~after
|
||||
~try-before
|
||||
~try-after
|
||||
~lift-rest
|
||||
~mixin
|
||||
~post-check
|
||||
|
|
54
private/before-after.rkt
Normal file
54
private/before-after.rkt
Normal 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)}}])))
|
|
@ -36,8 +36,6 @@
|
|||
(provide define-eh-alternative-mixin
|
||||
~seq-no-order
|
||||
~no-order
|
||||
~before
|
||||
~after
|
||||
~order-point
|
||||
order-point<
|
||||
order-point>
|
||||
|
@ -274,46 +272,6 @@
|
|||
(define-syntax-rule (try-order-point> a b)
|
||||
(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
|
||||
(pattern-expander
|
||||
(λ (stx)
|
||||
|
@ -323,7 +281,6 @@
|
|||
;; TODO: copy the disappeared uses instead of this hack
|
||||
{~do 'expanded-pats}
|
||||
{~bind [clause-present #t]}}]))))
|
||||
|
||||
|
||||
(define-eh-mixin-expander ~lift-rest
|
||||
(λ (stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user