(module syntax-utils mzscheme (require (lib "etc.ss") (lib "contract.ss") (planet "contract-utils.ss" ("cobbe" "contract-utils.plt" 2 (= 2)))) (provide/contract [identifier-name=? (syntax? syntax? . -> . boolean?)] [syntax-map ((any/c . -> . any/c) (syntax/c (listof any/c)) . -> . (listof any/c))] [syntax-prefix (string? identifier? . -> . identifier?)] [syntax-suffix (identifier? string? . -> . identifier?)] [string->identifier ([string?] [(optional/c syntax?)] . opt-> . identifier?)] [identifier->string (identifier? . -> . string?)] [identifier->string-literal (identifier? . -> . (syntax/c string?))]) (provide syntax-case-by-name) (define (syntax-map f stx) (map f (syntax->list stx))) (define (syntax-prefix prefix id) (string->identifier (string-append prefix (identifier->string id)) id)) (define (syntax-suffix id suffix) (string->identifier (string-append (identifier->string id) suffix) id)) (define string->identifier (opt-lambda (str [stx #f]) (datum->syntax-object stx (string->symbol str) stx))) (define (identifier->string-literal id) (datum->syntax-object id (identifier->string id) id)) (define (identifier->string id) (symbol->string (syntax-e id))) (define (identifier-name=? one two) (symbol=? (syntax-e one) (syntax-e two))) (define-syntax (syntax-case-by-name stx) (syntax-case stx () [(form arg (id ...) clause ...) (andmap identifier? (syntax->list (syntax (id ...)))) (syntax (syntax-case* arg (id ...) identifier-name=? clause ...))])) )