private/mpost-new-name.rkt
#lang racket
(provide new-var reset-new-var cache-value def-cache-value)
(require (planet wcy/anaphora))
(define var-name-length 4)
(define var-name-space-size 26)
(define (vector+  x y)
  (define n var-name-space-size)
  (define (vector+-normalized? x n)
    (for/and ((v1 (in-vector x)))
             (< v1 n)))
  (define (vector+-+ x y)
    (for/vector ((v1 (in-vector x))
                 (v2 (in-vector y)))
                (+ v1 v2)))
  (define (vector+-shift x)
    (let ((len (vector-length x)))
      (for/vector ((i (in-range len)))
                  (if (> i 0)
                      (vector-ref x (modulo (+ -1 i len) len)) 0))))
  (define (vector+-normalize x n)
    (if (vector+-normalized? x n)
        x
        (vector+-normalize
         (vector+-+ (for/vector ((v1 (in-vector x))) (modulo v1 n))
                    (vector+-shift
                     (for/vector ((v1 (in-vector x))) (quotient v1 n))))
         n)))
  (vector+-normalize 
   (vector+-+ x y) n))


(define zero (make-vector var-name-length 0))
(define one  (let ((r (make-vector var-name-length 0)))
               (vector-set!  r 0 1) r))
(define var-counter zero)
(define (my-number->char n) 
  (integer->char (modulo (+ (char->integer #\a) n) 255)))
(define (my-vector->string v)
  (aprogn
   (vector->list v)
   (reverse it)
   (map my-number->char it)
   (apply string it)))
(define (new-var prefix)
  (set! var-counter (vector+ one var-counter))
  (string-append prefix (my-vector->string var-counter)))
(define hash-table #f)
(define (reset-new-var)
  (set! var-counter zero)
  (set! hash-table (make-hash)))
(define (cache-value value)
  (hash-ref hash-table value #f))
(define (def-cache-value value name)
  (hash-set! hash-table value name)
  name)