suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simpler

Browse Source
This commit is contained in:
Matthew Butterick 2016-05-21 08:23:31 -07:00
parent 187230041e
commit c59b34f868
1 changed files with 18 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
beautiful-racket-lib/br/syntax.rkt
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 (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 (syntax-case-map stx) (define-syntax-rule (syntax-case-filter _stx-list _literals . _matchers)
(syntax-case stx () (let-values ([(matches others) (syntax-case-partition _stx-list _literals . _matchers)])
[(_ _stx-list literals . _matchers) matches))
#'(map (λ(stx-item)
(syntax-case stx-item literals
. _matchers)) (if (syntax? _stx-list) (define-syntax-rule (syntax-case-map _stx-list _literals . _matchers)
(syntax->list _stx-list) (map (λ(stx-item)
_stx-list))])) (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 ...)