before-after.rkt (1745B)
1 #lang racket 2 3 (require syntax/parse 4 phc-toolkit/untyped 5 (for-syntax racket/base 6 syntax/parse 7 phc-toolkit/untyped) 8 "no-order.rkt" 9 "pre.rkt" 10 "parameters.rkt") 11 12 (provide ~before 13 ~after 14 ~try-before 15 ~try-after) 16 17 (define-eh-mixin-expander ~before 18 (λ (stx) 19 (syntax-case stx () 20 [(_ other message pat …) 21 (and (identifier? #'other) 22 (string? (syntax-e #'message))) 23 (with-syntax ([pt (get-new-clause!)]) 24 #'{~order-point pt 25 {~seq pat …} 26 {~pre-fail message #:when (order-point> pt other)}})]))) 27 28 (define-eh-mixin-expander ~after 29 (λ (stx) 30 (syntax-case stx () 31 [(_ other message pat …) 32 (and (identifier? #'other) 33 (string? (syntax-e #'message))) 34 (with-syntax ([pt (get-new-clause!)]) 35 #'{~order-point pt 36 {~seq pat …} 37 {~pre-fail message #:when (order-point< pt other)}})]))) 38 39 (define-eh-mixin-expander ~try-before 40 (λ (stx) 41 (syntax-case stx () 42 [(_ other message pat …) 43 (and (identifier? #'other) 44 (string? (syntax-e #'message))) 45 (with-syntax ([pt (get-new-clause!)]) 46 #'{~order-point pt 47 {~seq pat …} 48 {~pre-fail message #:when (try-order-point> pt other)}})]))) 49 50 (define-eh-mixin-expander ~try-after 51 (λ (stx) 52 (syntax-case stx () 53 [(_ other message pat …) 54 (and (identifier? #'other) 55 (string? (syntax-e #'message))) 56 (with-syntax ([pt (get-new-clause!)]) 57 #'{~order-point pt 58 {~seq pat …} 59 {~pre-fail message #:when (try-order-point< pt other)}})])))