diff --git a/main.rkt b/main.rkt index 97eedfc..eed1d92 100644 --- a/main.rkt +++ b/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 diff --git a/private/before-after.rkt b/private/before-after.rkt new file mode 100644 index 0000000..0d858f0 --- /dev/null +++ b/private/before-after.rkt @@ -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)}}]))) \ No newline at end of file diff --git a/private/no-order.rkt b/private/no-order.rkt index fc5f025..d6636f9 100644 --- a/private/no-order.rkt +++ b/private/no-order.rkt @@ -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)