pull/2/head
Matthew Butterick 9 years ago
parent 187230041e
commit c59b34f868

@ -35,31 +35,26 @@
(define identity (λ(arg) arg))
(define-syntax (syntax-case-partition stx)
(syntax-case stx ()
[(_ _stx-list literals . _matchers)
#'(partition (λ(stx-item)
(define-syntax-rule (syntax-case-partition _stx-list _literals . _matchers)
(partition (λ(stx-item)
(with-handlers ([exn:fail:syntax? (λ (exn) #f)])
(syntax-case stx-item literals
(syntax-case stx-item _literals
. _matchers))) (if (syntax? _stx-list)
(syntax->list _stx-list)
_stx-list))]))
_stx-list)))
(define-syntax (syntax-case-filter stx)
(syntax-case stx ()
[(_ _stx-list literals . _matchers)
#'(let-values ([(matches others) (syntax-case-partition _stx-list literals . _matchers)])
matches)]))
(define-syntax-rule (syntax-case-filter _stx-list _literals . _matchers)
(let-values ([(matches others) (syntax-case-partition _stx-list _literals . _matchers)])
matches))
(define-syntax (syntax-case-map stx)
(syntax-case stx ()
[(_ _stx-list literals . _matchers)
#'(map (λ(stx-item)
(syntax-case stx-item literals
(define-syntax-rule (syntax-case-map _stx-list _literals . _matchers)
(map (λ(stx-item)
(syntax-case stx-item _literals
. _matchers)) (if (syntax? _stx-list)
(syntax->list _stx-list)
_stx-list))]))
_stx-list)))
(define-syntax-rule (reformat-id fmt id0 id ...)

Loading…
Cancel
Save