mbutterick
/
beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

simpler

Browse Source
pull/2/head
Matthew Butterick 8 years ago
parent 187230041e
commit c59b34f868
1 changed files with 20 additions and 25 deletions
Show Stats Download Patch File Download Diff File

45
beautiful-racket-lib/br/syntax.rkt
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save