optional.rkt (1891B)
1 #lang racket/base 2 3 (require syntax/parse 4 phc-toolkit/untyped 5 (for-syntax racket/base 6 syntax/parse 7 phc-toolkit/untyped) 8 "parameters.rkt" 9 "no-order.rkt") 10 11 (provide ~optional/else) 12 13 (begin-for-syntax 14 (define-splicing-syntax-class else-post-fail 15 (pattern (~seq #:else-post-fail message #:when condition)) 16 (pattern (~seq #:else-post-fail #:when condition message)) 17 (pattern (~seq #:else-post-fail message #:unless unless-condition) 18 #:with condition #'(not unless-condition)) 19 (pattern (~seq #:else-post-fail #:when unless-condition message) 20 #:with condition #'(not unless-condition)))) 21 22 23 (define-eh-mixin-expander ~optional/else 24 (syntax-parser 25 [(_ pat 26 (~optional (~seq #:defaults (default-binding ...)) 27 #:defaults ([(default-binding 1) (list)])) 28 :else-post-fail 29 ... 30 (~optional (~seq #:name name))) 31 #:with clause-whole (get-new-clause!) 32 #:with clause-present (get-new-clause!) 33 (for ([message (in-syntax #'(message ...))] 34 [condition (in-syntax #'(condition ...))]) 35 (eh-post-accumulate! '~optional/else 36 #`(~fail #:when (and (eq? (attr clause-present) 0) 37 #,condition) 38 #,message))) 39 #`(~optional (~and pat 40 ;(~seq clause-whole (... ...)) 41 ;; can't use #f, because of the bug 42 ;; https://github.com/racket/racket/issues/1437 43 (~bind [clause-present 1])) 44 #:defaults (default-binding ... 45 ;[(clause-whole 1) #'()] 46 [clause-present 0]) 47 #,@(if (attribute name) #'(#:name name) #'()))]))