www

commit 0b6508958f1fb9919729f4f3409a98b748843b8e
parent 4dc694382fb1fe260abd6953a8c735b501261903
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Fri, 23 Sep 2016 00:02:04 +0200

bugfix

Diffstat:
M
main.rkt
 | 
3
+++
A
private/before-after.rkt
 | 
55
+++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
private/no-order.rkt
 | 
43
-------------------------------------------

3 files changed, 58 insertions(+), 43 deletions(-)
diff --git 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
@@ -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
@@ -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)