www

commit 354794a1856a73324e2ffb492040cfacef65d7d1
parent 0b6508958f1fb9919729f4f3409a98b748843b8e
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Fri, 23 Sep 2016 00:31:08 +0200

Preemptive bugfix

Diffstat:
M
private/before-after.rkt
 | 
33
+++++++++++++++++++--------------
M
private/no-order.rkt
 | 
2
+-

2 files changed, 20 insertions(+), 15 deletions(-)
diff --git a/private/before-after.rkt b/private/before-after.rkt
@@ -6,7 +6,8 @@
                      syntax/parse
                      phc-toolkit/untyped)
          "no-order.rkt"
-         "pre.rkt")
+         "pre.rkt"
+         "parameters.rkt")
 
 (provide ~before
          ~after
@@ -19,9 +20,10 @@
       [(_ other message pat …)
        (and (identifier? #'other)
             (string? (syntax-e #'message)))
-       #'{~order-point pt
-           {~seq pat …}
-           {~pre-fail message #:when (order-point> pt other)}}])))
+       (with-syntax ([pt (get-new-clause!)])
+         #'{~order-point pt
+             {~seq pat …}
+             {~pre-fail message #:when (order-point> pt other)}})])))
 
 (define-eh-mixin-expander ~after
   (λ (stx)
@@ -29,9 +31,10 @@
       [(_ other message pat …)
        (and (identifier? #'other)
             (string? (syntax-e #'message)))
-       #'{~order-point pt
-           {~seq pat …}
-           {~pre-fail message #:when (order-point< pt other)}}])))
+       (with-syntax ([pt (get-new-clause!)])
+         #'{~order-point pt
+             {~seq pat …}
+             {~pre-fail message #:when (order-point< pt other)}})])))
 
 (define-eh-mixin-expander ~try-before
   (λ (stx)
@@ -39,9 +42,10 @@
       [(_ other message pat …)
        (and (identifier? #'other)
             (string? (syntax-e #'message)))
-       #'{~order-point pt
-           {~seq pat …}
-           {~pre-fail message #:when (try-order-point> pt other)}}])))
+       (with-syntax ([pt (get-new-clause!)])
+         #'{~order-point pt
+             {~seq pat …}
+             {~pre-fail message #:when (try-order-point> pt other)}})])))
 
 (define-eh-mixin-expander ~try-after
   (λ (stx)
@@ -49,6 +53,7 @@
       [(_ 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
+       (with-syntax ([pt (get-new-clause!)])
+         #'{~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
@@ -216,7 +216,7 @@
                                     1)
                           (string-append "more than one of the lifted rest"
                                          " patterns matched")}))))
-        ((λ (x) #;(pretty-write (syntax->datum x)) x)
+        ((λ (x) (pretty-write (syntax->datum x)) x)
          #`(~delimit-cut
             (~and #,(fix-disappeared-uses)
                   whole-clause-pat