diff --git a/main.rkt b/main.rkt index f8f976a..f4264c7 100644 --- a/main.rkt +++ b/main.rkt @@ -18,6 +18,7 @@ ~mixin ~post-check ~post-fail + ~whole ~nop ~optional/else ~global-or diff --git a/private/post.rkt b/private/post.rkt index 3d8a31a..f62335e 100644 --- a/private/post.rkt +++ b/private/post.rkt @@ -10,7 +10,8 @@ (provide ~nop ~post-check - ~post-fail) + ~post-fail + ~whole) (define-syntax ~nop (pattern-expander @@ -26,10 +27,36 @@ (begin (eh-post-accumulate! '~post-check #'post) #'(~nop))]))) +#;(define-eh-mixin-expander ~defaults + (λ (stx) + (syntax-case stx () + [(_ ([a v] ...) . pats) + (let () + (define/with-syntax clause-present (get-new-clause!)) + (eh-post-accumulate! '~defaults + #'(~bind [a (or (attribute clause-present) v)] + ...)) + #'(~and (~bind [clause-present #t]) . pats))]))) + +(define-eh-mixin-expander ~whole + (λ (stx) + (syntax-case stx () + [(_ id . pats) + (let () + (define/with-syntax clause-present (get-new-clause!)) + (define/with-syntax clause (get-new-clause!)) + (eh-post-accumulate! '~whole + #'(~bind [(id 1) (if (attribute clause-present) + (attribute clause) + (list))])) + #'(~and (~bind [clause-present #t]) + (~seq clause (... ...)) + (~seq . pats)))]))) + (define-for-syntax (post-fail stx) (syntax-case stx () [(_ message #:when condition) - (begin + (let () (define/with-syntax clause-present (get-new-clause!)) (eh-post-accumulate! '~post-fail #`(~fail #:when (and (attribute clause-present)