;;;; memoized-string.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Oct '17
;;;; Kon Lovett, Aug '10

(module memoized-string

;FIXME should export 'global-string', 'string' & 'make-string'
(;export
  global-string
  string+
  make-string+)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (only utf8 string make-string string-length string-ref))
(import (only utf8-srfi-13 string= string-hash))
(import (only (srfi 1) every))
(import (only (srfi 69) make-hash-table hash-table-ref/default hash-table-set!))
(import (only type-checks check-list check-natural-fixnum check-char check-string))

;;

(: global-string (string --> string))
(: string+ (#!rest char --> string))
(: make-string+ (fixnum #!optional char --> string))

;;

(define *empty-string* "")

;;

(define (global-string str) (*string+ (check-string 'global-string str)))

;;


(define (string+ . chars)
  (let ((len (length chars)))
    (if (zero? len) *empty-string*
      (begin
        #;(every (cut check-char 'string+ <>) chars)
        (check-list 'string+ chars)
        (*string+ len (car chars) (delay (apply string chars))) ) ) ) )

;; Memeoized `make-string'

(define (make-string+ len #!optional (fill #\space))
  (*make-string+
    (check-natural-fixnum 'make-string+ len)
    (check-char 'make-string+ fill)) )

;;

(define (ensure-index-entry ht len ch dat)
  (let ((key `(,len . ,ch)))
    (or
      (hash-table-ref/default ht key #f)
      (let ((dat (force dat)))
        (hash-table-set! ht key dat)
        dat ) ) ) )

(define (ensure-string-entry ht len ch str)
  (let (
    (strtbl (ensure-index-entry ht len ch (delay (make-hash-table string= string-hash))) )
    (str (force str) ) )
    (or
      (hash-table-ref/default strtbl str #f)
      (begin
        (hash-table-set! strtbl str str)
        str ) ) ) )
    ;

(define *string+
  (let ((+strings+ (make-hash-table equal?)))
    (case-lambda
      ((str)
        (let* (
          (len (string-length str))
          (ch (and (not (= 0 len)) (string-ref str 0))) )
          (*string+ len ch str) ) )
      ((len ch str)
        (if (zero? len) *empty-string*
          (ensure-string-entry +strings+ len ch str) ) ) ) ) )

(define *make-string+
  (let ((+strings+ (make-hash-table equal?)))
    (case-lambda
      ((len ch)
        (*make-string+ len ch (delay (make-string len ch))) )
      ((len ch str)
        (if (zero? len) *empty-string*
          (ensure-index-entry +strings+ len ch str) ) ) ) ) )

) ;module memoized-string