post.rkt (1782B)
1 #lang racket/base 2 3 (require syntax/parse 4 (for-syntax racket/base 5 syntax/parse 6 racket/syntax 7 phc-toolkit/untyped) 8 "parameters.rkt" 9 "no-order.rkt" 10 "nop.rkt") 11 12 (provide ~post-check 13 ~post-fail) 14 15 (define-eh-mixin-expander ~post-check 16 (λ (stx) 17 (syntax-case stx () 18 [(_ pat post) 19 (begin (eh-post-accumulate! '~post-check #'post) 20 #'pat)] 21 [(_ post) 22 (begin (eh-post-accumulate! '~post-check #'post) 23 #'(~nop))]))) 24 25 #;(define-eh-mixin-expander ~defaults 26 (λ (stx) 27 (syntax-case stx () 28 [(_ ([a v] ...) . pats) 29 (let () 30 (define/with-syntax clause-present (get-new-clause!)) 31 (eh-post-accumulate! '~defaults 32 #'(~bind [a (or (attribute clause-present) v)] 33 ...)) 34 #'(~and (~bind [clause-present #t]) . pats))]))) 35 36 (define-for-syntax (post-fail stx) 37 (syntax-case stx () 38 [(_ message #:when condition) 39 (let () 40 (define/with-syntax clause-present (get-new-clause!)) 41 (eh-post-accumulate! '~post-fail 42 #`(~fail #:when (and (attribute clause-present) 43 condition) 44 message)) 45 #'(~bind [clause-present #t]))] 46 [(self #:when condition message) 47 (post-fail #'(self message #:when condition))] 48 [(self message #:unless unless-condition) 49 (post-fail #'(self message #:when (not unless-condition)))] 50 [(self #:unless unless-condition message) 51 (post-fail #'(self message #:when (not unless-condition)))])) 52 53 (define-eh-mixin-expander ~post-fail post-fail)