modular/expansion/tags.scm
(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))

  )