;;;; memoized-string.scm  -*- Hen -*-
;;;; Kon Lovett, Oct '17
;;;; Kon Lovett, Aug '10

(module memoized-string

(;export
  memorize-string
  make-string+
  string+
  ;DEPRECATED
  make-string*)

(import scheme)

(import chicken)

(import
  (only srfi-69
    make-hash-table hash-table-ref/default hash-table-set!) )
(require-library srfi-69)

(import
  (only unicode-utils
    ascii-codepoint? unicode-make-string)
  (only type-checks
    check-natural-fixnum check-char
    check-string))
(require-library
  unicode-utils
  type-checks)

;;

(define (memorize-string str)
  (check-string 'memorize-string str)
  (*make-string+ str) )

;;

(define (string+ . chars)
  (let* (
    (len (length chars) )
    (ch (and (not (zero? len)) (car chars)) ) )
    ;
    (*make-string+ len ch (list->string chars)) ) )

;; Memeoized `make-string'

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

;;

(define (my-make-string len ch)
  (if (ascii-codepoint? ch)
    (make-string len ch)
    (unicode-make-string len ch) ) )

(define *make-string+
  (let ((+strings+ (make-hash-table equal?)))
    (case-lambda
      ((str)
        (let* (
          (len (string-length str) )
          (ch (and (not (zero? len)) (string-ref str 0)) ) )
          ;
          (*make-string+ len ch str) ) )
      ((len ch)
        (*make-string+ len ch (delay (my-make-string len ch))) )
      ((len ch str)
        (if (zero? len)
          ""
          (let ((key `(,ch . ,len)))
            (or
              (hash-table-ref/default +strings+ key #f)
              (let ((str (force str)))
                (hash-table-set! +strings+ key str)
                str #;(*make-string+ len ch str) ) ) ) ) ) ) ) )

;DEPRECATED
(define make-string* make-string+)

) ;module memoized-string