commit c0eb19841905fcac58cbba0fcbe711d9257e42ca parent 61181270f362856eb91625f99630f93105fe36f1 Author: JackFirth <jackhfirth@gmail.com> Date: Tue, 9 Dec 2014 22:30:22 -0800 Utils Split out utils Diffstat:
| A | stx-utils.rkt | | | 48 | ++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 48 insertions(+), 0 deletions(-)
diff --git a/stx-utils.rkt b/stx-utils.rkt @@ -0,0 +1,48 @@ +#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)) +