converting scopes to symbols to make scope-sets more readable

scope-to-symbol.rkt

#lang racket/base

(provide make-scope->symbol-function)

(module+ test
  (require racket/function rackunit)
  (define-syntax-rule (check f g [a b] ...)
    (test-case (symbol->string 'f)
      (check-equal? (f a) (g b)) ...)))

;; ----------------------------------------------------------------------------

;; Generating Symbols for Scopes

;; A ScopeVec is a (vector Integer Any ...)

;; scope-vec->number : ScopeVec -> Integer
;; Finds the number associated with the given scope
(define (scope-vec->number scope-vec)
  (vector-ref scope-vec 0))

;; make-scope->symbol-function : -> [ScopeVec -> Symbol]
;; Produces a function that generates new symbols in
;; lexicographic order for each new scope number
(define (make-scope->symbol-function)
  ;; scope-num->symbol : ScopeVec -> Symbol
  (define scope-num->symbol (make-scope-num->symbol-function))
  ;; scope->symbol : ScopeVec -> Symbol
  (define (scope->symbol scope-vec)
    (scope-num->symbol (scope-vec->number scope-vec)))
  scope->symbol)

;; make-scope-num->symbol-function :
;; -> [Integer -> Symbol]
;; Produces a function that generates new symbols in
;; lexicographic order for each new scope number
(module+ test
  (define scope-num->symbol (make-scope-num->symbol-function))
  (define scope-num->symbol-2 (make-scope-num->symbol-function))

  (check scope-num->symbol quote
         [3 a]
         [1 b] [4 c] [1 b] [5 d] [9 e]
         [2 f] [6 g] [5 d] [3 a] [5 d]
         [8 h] [9 e] [7 i] [9 e] [32 j] [38 k] [46 l]
         [26 m] [43 n] [38 k] [32 j] [79 o]
         [50 p] [28 q] [84 r] [19 s] [71 t]
         [69 u] [39 v] [93 w] [75 x] [10 y]
         [58 z] [20 aa] [97 ab] [49 ac] [44 ad])

  (check scope-num->symbol-2 quote
         [6 a]
         [2 b] [8 c] [3 d] [1 e] [8 c]
         [5 f] [3 d] [0 g] [7 h] [1 e]
         [7 h] [9 i] [5 f] [8 c] [6 a]
         [4 j] [7 h] [6 a] [9 i] [2 b]
         [52 k] [86 l] [76 m] [65 n] [59 o]
         [00 g] [57 p] [68 q] [39 r] [43 s])

  (check scope-num->symbol quote
         [59 ae] [23 af] [07 i] [81 ag] [64 ah]
         [06 g] [28 q] [62 ai] [08 h] [99 aj]
         [86 ak] [28 q] [03 a] [48 al] [25 am]
         [34 an] [21 ao] [17 ap] [06 g] [79 o]
         [82 aq] [14 ar] [80 as] [86 ak] [51 at]
         [32 j] [82 aq] [30 au] [66 av] [47 aw]
         [09 e] [38 k] [44 ad] [60 ax] [95 ay]
         [50 p] [58 z] [22 az] [31 ba] [72 bb]
         [53 bc] [59 ae] [40 bd] [81 ag] [28 q]))

(define (make-scope-num->symbol-function)
  ;; generate-next-symbol : -> Symbol
  (define generate-next-symbol (make-symbol-generator))
  (memoize/eq (λ (scope-num) (generate-next-symbol))))

;; make-symbol-generator : -> [-> Symbol]
;; Produces a function that generates new symbols in
;; lexicographic order
(module+ test
  (define generate-symbol (make-symbol-generator))
  (check-equal? (build-list
                 104
                 (λ (i) (generate-symbol)))
                '(a b c d e f g h
                  i j k l m n o p
                  q r s t u v w x
                  y z
                  aa ab ac ad ae af ag ah
                  ai aj ak al am an ao ap
                  aq ar as at au av aw ax
                  ay az
                  ba bb bc bd be bf bg bh
                  bi bj bk bl bm bn bo bp
                  bq br bs bt bu bv bw bx
                  by bz
                  ca cb cc cd ce cf cg ch
                  ci cj ck cl cm cn co cp
                  cq cr cs ct cu cv cw cx
                  cy cz)))

(define (make-symbol-generator)
  ;; num : Natural
  ;; A local mutable variable that tracks the next
  ;; number to use for the next symbol
  (define num 1)
  ;; generate-next-symbol : -> Symbol
  (define (generate-next-symbol)
    (begin0
      (string->symbol (nth-string num))
      (set! num (add1 num))))
  generate-next-symbol)

;; ----------------------------------------------------------------------------

;; Memoization

;; memoize/eq : [A -> B] -> [A -> B]
;; Produces a memoized version of f
(define (memoize/eq f)
  ;; hsh : (Hashof A B)
  ;; A local mutable hash table mapping previous
  ;; arguments to their corresponding results
  (define hsh (make-hasheq))
  ;; memoized : [A -> B]
  ;; The memoized verison of f
  (define (memoized a)
    (hash-ref! hsh a (λ () (f a))))
  memoized)

;; ----------------------------------------------------------------------------

;; Lexicographic Order

(define alphabet "abcdefghijklmnopqrstuvwxyz")

;; An [Integer-in a b] is a Natural number in the range
;; from a to b, inclusive

;; nth-letter : [Integer-in 0 25] -> 1String
;; Produces the nth letter of the alphabet (0-indexed)
(module+ test
  (check nth-letter identity
         [0 "a"]
         [1 "b"]
         [2 "c"]
         [3 "d"]
         [4 "e"]
         [8 "i"]
         [12 "m"]
         [16 "q"]
         [20 "u"]
         [24 "y"]
         [25 "z"]))

(define (nth-letter n)
  (string (string-ref alphabet n)))

;; natural->string : Natural -> String
;; Produces the nth alphabetical string in lexicographic
;; order
(module+ test
  (check nth-string identity
         [ 0 ""]
         [ 1 "a"]
         [ 2 "b"]
         [26 "z"]
         [(+ (*  1 26)  1) "aa"]
         [(+ (*  1 26)  2) "ab"]
         [(+ (*  1 26) 26) "az"]
         [(+ (*  2 26)  1) "ba"]
         [(+ (*  2 26)  2) "bb"]
         [(+ (*  2 26) 26) "bz"]
         [(+ (* 26 26)  1) "za"]
         [(+ (* 26 26)  2) "zb"]
         [(+ (* 26 26) 26) "zz"]
         [(+ (* (+ (*  1 26)  1) 26)  1) "aaa"]
         [(+ (* (+ (*  1 26)  1) 26)  2) "aab"]
         [(+ (* (+ (*  1 26)  2) 26)  1) "aba"]
         [(+ (* (+ (*  2 26)  1) 26)  1) "baa"]
         [(+ (* (+ (*  1 26)  2) 26) 26) "abz"]
         [(+ (* (+ (*  1 26) 26) 26)  2) "azb"]
         [(+ (* (+ (* 26 26)  1) 26)  2) "zab"]))

(define (nth-string n)
  (cond [(zero? n) ""]
        [else (string-append
               (nth-string (quotient (- n 1) 26))
               (nth-letter (remainder (- n 1) 26)))]))