identifier.rkt

#lang racket/base
(provide identifier->symbol symbol->identifier
         identifier->string string->identifier
         identifier-append)

(define (identifier->symbol id)
  (syntax->datum id))
(define (symbol->identifier sym [srcloc #f])
  (datum->syntax (if (syntax? srcloc) srcloc #f)
                 sym srcloc))

(define (identifier->string id)
  (symbol->string (identifier->symbol id)))
(define (string->identifier str [srcloc #f])
  (symbol->identifier (string->symbol str) srcloc))

(define (identifier-append #:srcloc [srcloc #f] . id*)
  (string->identifier (apply string-append (map identifier->string id*))
                      srcloc))

(module+ test
  (require rackunit
           racket/syntax-srcloc)
  (define-binary-check (check-identifier-equal? actual expected)
    (free-identifier=? actual expected))
  (define-binary-check (check-identifier-strict-equal? actual expected)
    (and (equal? (syntax-srcloc actual) (syntax-srcloc expected))
         (free-identifier=? actual expected)))

  (check-identifier-equal? (symbol->identifier 'abc) #'abc)

  (test-case "convert identifier to string"
             (check-equal? (identifier->string #'abc) "abc")
             (check-equal? (identifier->string #'abc2) "abc2")
             (check-equal? (identifier->string #'+-*/~!@$#%^&*) "+-*/~!@$#%^&*")
             (check-equal? (identifier->string #'| |) " "))
  (test-case "convert string to identifier"
             (check-identifier-equal? (string->identifier "abc") #'abc)
             (define stx #'def)
             (check-identifier-strict-equal? (string->identifier "def" stx)
                                             stx))
  (test-case "concat identifiers"
             (check-identifier-equal? (identifier-append #'a #'bc) #'abc)
             (define stx #'hello-world)
             (check-identifier-strict-equal? (identifier-append #'hello #'-world
                                                                #:srcloc stx)
                                             stx)))