(module tags mzscheme (require (lib "contract.ss") (lib "plt-match.ss") (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 3)) "syntax-errors.scm" "idmap.scm") (provide/contract [tag-id (-> identifier? identifier? identifier?)] [retag (-> idmap? identifier? identifier?)]) (define (tag-id tag id) (syntax-prefix (string-append (identifier->string tag) ".") id)) (define (retag tags id) (match (regexp-match "^([^.]+)[.]([^.]+)$" (identifier->string id)) [#f id] [(list full prefix suffix) (let* ([tag (idmap-get tags (make-id id prefix) (lambda () #f))]) (if tag (tag-id tag (make-id id suffix)) id))])) (define (make-id stx string) (datum->syntax-object stx (string->symbol string) stx stx stx)) )