;;;; symbol-utils.gen.scm  -*- Scheme -*-
;;;; Kon Lovett, Oct '22

;"atomic"
(declare (disable-interrupts))

(module (symbol-utils gen)

(;export
  make-gensym)

(import scheme utf8 (chicken base) (chicken type))

(: make-gensym ((or symbol string) --> (#!optional (or symbol string) -> symbol)))

(define (str-or-sym loc tag)
  (cond ((not tag) "")
        ((symbol? tag) (symbol->string tag))
        ((string? tag) tag)
        (else (error loc "bad argument - not a string or symbol" tag))) )

(define (make-gensym bas)
  (letrec ((+bas+ (str-or-sym 'make-gensym bas))
           (+cnt+ 0)
           (cnt++ (lambda () (let ((cnt +cnt+)) (set! +cnt+ (+ +cnt+ 1)) cnt))) )
    (lambda (#!optional tag)
      (string->uninterned-symbol
       (string-append +bas+ (str-or-sym 'make-gensym tag) (number->string (cnt++)))) ) ) )

) ;module (symbol-utils gen)