; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.

; Syms are unique, serializable generated names.  Uniqueness is
; ensured (almost ...) through randomization.  

; A sym has two components: Its "pretty string" is supplied upon
; generation, and for informational purposes only.  Its "unique
; string" (generated on demand) identifies the sym.

; Comparison of syms happens happens via `eq?', which is why the
; system has to make sure there's only one sym for each unique string.

(define *sym-unique-size* 16)

; Part of the RTS, so no `define-synchronized-record-type'
;(define-synchronized-record-type sym :sym
;  (really-make-sym pretty-string unique-string hash)
;  (unique-string)
;  sym?
;  (pretty-string sym-pretty-string)
;  (unique-string really-sym-unique-string set-sym-unique-string!)
;  (hash really-sym-hash set-sym-hash!))
(define :sym (make-record-type 'sym '(pretty-string unique-string hash)))
(define (really-make-sym pretty-string unique-string hash)
  (record :sym pretty-string unique-string hash))
(define (sym? x)
  (and (record? x) (eq? (record-ref x 0) :sym)))
(define (sym-pretty-string s)
  (checked-record-ref s :sym 1))
(define (really-sym-unique-string s)
  (provisional-checked-record-ref s :sym 2))
(define (set-sym-unique-string! s new)
  (provisional-checked-record-set! s :sym 2 new))
(define (really-sym-hash s)
  (checked-record-ref s :sym 3))
(define (set-sym-hash! s new)
  (checked-record-set! s :sym 3 new))
       
(define-record-discloser :sym
  (lambda (r)
    (list 'sym (sym-pretty-string r) (sym-unique-string r))))

(define (make-sym name)
  (really-make-sym (cond
		    ((symbol? name) (symbol->string name))
		    ((string? name) name)
		    ((sym? name) (sym-pretty-string name))
		    (else
		     (assertion-violation 'make-sym "invalid pretty name" name)))
		   #f #f))

(define (sym-unique-string sym)
  (call-atomically
   (lambda ()
     (or (really-sym-unique-string sym)
	 (let ((unique (make-string *sym-unique-size*)))
	   (randomize-string! unique)
	   (set-sym-unique-string! sym unique)
	 unique)))))

(define (sym-hash sym)
  (or (really-sym-hash sym)
      (let ((hash (string-hash (sym-pretty-string sym))))
	(set-sym-hash! sym hash)
	hash)))
