49 lines
1.5 KiB
Racket
49 lines
1.5 KiB
Racket
#lang racket
|
|
|
|
(require predicates
|
|
racket/syntax
|
|
syntax/parse
|
|
syntax/parse/define)
|
|
|
|
(provide with-derived-ids
|
|
identifier-bound-to?
|
|
stx-expander
|
|
syntax-list-with-head?)
|
|
|
|
(define (disp a) (displayln a) a)
|
|
|
|
;; Takes a predicate p and produces a predicate satisfied by syntax objects
|
|
;; which are identifiers bound to values satisfying p
|
|
(define (identifier-bound-to? p)
|
|
(and? identifier?
|
|
(compose p maybe-syntax-local-value)))
|
|
|
|
(define (syntax-list-with-head? . ps)
|
|
(compose (apply list-with-head? ps)
|
|
syntax->list))
|
|
|
|
;; Falsey non-throwing verison of syntax-local-value
|
|
(define (maybe-syntax-local-value stx)
|
|
(syntax-local-value stx (λ () #f)))
|
|
|
|
;; Takes a syntax-object predicate and a syntax transformer, then returns
|
|
;; a procedure that parses a syntax object and determines at each level of
|
|
;; the syntax tree if that subtree satisfies the predicate. If it does,
|
|
;; that subtree is replaced with the result of (transformer subtree-stx)
|
|
(define ((stx-expander expand? transformer) stx)
|
|
(if (expand? stx)
|
|
(transformer stx)
|
|
(syntax-parse stx
|
|
[(a . b) #`(#,((stx-expander expand? transformer) #'a)
|
|
#,@((stx-expander expand? transformer) #'b))]
|
|
[() #'()]
|
|
[a #'a])))
|
|
|
|
(define-simple-macro (with-derived-ids ([pat-id:id format base-id-stx] ...) stx-expr)
|
|
(with-syntax ([pat-id
|
|
(format-id base-id-stx
|
|
format
|
|
base-id-stx)] ...)
|
|
stx-expr))
|
|
|