31 lines
854 B
Scheme
31 lines
854 B
Scheme
|
;;;; symbol-utils.gen.scm -*- Scheme -*-
|
||
|
|
;;;; Kon Lovett, Oct '22
|
||
|
|
|
||
|
|
;"atomic"
|
||
|
|
(declare (disable-interrupts))
|
||
|
|
|
||
|
|
(module (symbol-utils gen)
|
||
|
|
|
||
|
|
(;export
|
||
|
|
make-gensym)
|
||
|
|
|
||
|
|
(import scheme (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)
|