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

View File

@ -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
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)}}])))

View File

@ -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)