Carp/core/String.carp

(system-include "carp_string.h")

(defmodule String

  (register =          (Fn [&String &String] Bool))
  (register append     (Fn [&String &String] String))
  (register delete     (Fn [String] ()))
  (register copy       (Fn [&String] String))
  (register count      (Fn [&String] Int))
  (register duplicate  (Fn [&String] String))
  (register cstr       (Fn [&String] (Ptr Char)))
  (register str        (Fn [&String] String))
  (register prn        (Fn [&String] String))
  (register char-at    (Fn [&String Int] Char))
  (register chars      (Fn [&String] (Array Char)))
  (register from-chars (Fn [&(Array Char)] String))
  (register tail (λ [(Ref String)] String))
  (register format (Fn [&String &String] String))
  (register string-set! (Fn [&String Int Char] ()))
  (register string-set-at! (Fn [&String Int &String] ()))
  (register allocate (Fn [Int, Char] String))

  (defn /= [a b]
    (not (= (the (Ref String) a) b)))

  (doc head "Returns the character at start of string.")
  (defn head [s]
    (char-at s 0))

  (doc repeat "Returns a new string which is `inpt` repeated `n` times.")
  (defn repeat [n inpt]
    (let [str @""]
      (do
        (for [i 0 n]
          (set! str (append &str inpt)))
        str)))

  (defn pad-left [len pad s]
    (let [x (Int.max 0 (- len (count s)))]
      (append &(from-chars &(Array.replicate x &pad)) s)))

  (defn pad-right [len pad s]
    (let [x (Int.max 0 (- len (count s)))]
      (append s &(from-chars &(Array.replicate x &pad)))))

  (doc count-char "Returns the number of occurrences of `c` in the string `s`.")
  (defn count-char [s c]
    (let-do [n 0]
      (for [i 0 (count s)]
        (when (= c (char-at s i))
          (set! n (Int.inc n))))
      n))

  (doc reverse "Produce a new string which is `s` reversed.")
  (defn reverse [s]
    (from-chars &(Array.reverse (chars s))))

  (doc empty? "Check if the string is the empty string.")
  (defn empty? [s]
    (Int.= (count s) 0))

  (defn substring [s a b]
    (from-chars &(Array.subarray &(chars s) a b)))

  (doc prefix-string "Return the first `a` characters of the string `s`.")
  (defn prefix-string [s a]
    (from-chars &(Array.prefix-array &(chars s) a)))

  (doc suffix-string "Return the last `b` characters of the string `s`.")
  (defn suffix-string [s b]
    (from-chars &(Array.suffix-array &(chars s) b)))

  (doc starts-with? "Check if the string `s` begins with the string `sub`.")
  (defn starts-with? [s sub]
    (= sub &(prefix-string s (count sub))))

  (doc starts-with? "Check if the string `s` ends with the string `sub`.")
  (defn ends-with? [s sub]
    (= sub &(suffix-string s (- (count s) (count sub)))))

  (doc zero "The empty string.")
  (defn zero [] @"")

  (doc sum-count "Returns the sum of counts from an array of Strings.")
  (defn sum-count [strings]
    (let-do [sum 0
             lstrings (Array.count strings)]
      (for [i 0 lstrings]
        (set! sum (+ sum (String.count (Array.nth strings i)))))
      sum))

  (doc concat "Returns a new string which is the concatenation of the provided `strings`.")
  (defn concat [strings]
    ;; This is using a StringBuilder pattern to only perform one allocation and
    ;; to only copy each of the incoming strings once.
    ;; This currently performs wasted String.count calls, as we call it for each
    ;; string once here and once in sum-count.
    (let-do [j 0
             result (String.allocate (sum-count strings) \ )
             lstrings (Array.count strings)]
         (for [i 0 lstrings]
           (let-do [str (Array.nth strings i)
                    len (String.count str)]
             (string-set-at! &result j str)
             (set! j (+ j len))))
         result))

  ;; TODO: Should use some kind of "StringBuilder" instead of generating intermediate strings.
  (doc join "Returns a new string which is the concatenation of the provided `strings` separated by `sep`.")
  (defn join [sep strings]
    (let-do [result @""
             len (Array.count strings)]
      (for [i 0 len]
        (do
          (when (> i 0)
            (set! result (String.append &result sep)))
          (set! result (String.append &result (Array.nth strings i)))))
      result))
)

(defmodule StringCopy
  (register append     (Fn [String String] String))

  (defn = [a b]
    (String.= &a &b))

  (defn /= [a b]
    (String./= &a &b))
)

(defdynamic string-join- [strs]
  (if (= (count strs) 0)
    '(String.copy "")
    (list 'StringCopy.append (car strs) (string-join- (cdr strs)))))

;; TODO: Remove this function and replace uses with 'str*'
(defmacro string-join [:rest strs]
  (string-join- strs))

(defmodule Bool
  (register str (Fn [Bool] String))
  (register format (Fn [&String Bool] String))
)

(defmodule Int
  (register str (Fn [Int] String))
  (register format (Fn [&String Int] String))
  (register from-string (λ [&String] Int))
)

(defmodule Float
  (register str (Fn [Float] String))
  (register format (Fn [&String Float] String))
)

(defmodule Long
  (register str (Fn [Long] String))
  (register format (Fn [&String Long] String))
  (register from-string (λ [&String] Long))
)

(defmodule Double
  (register str (Fn [Double] String))
  (register format (Fn [&String Double] String))
)

(defmodule Char
  (register str (Fn [Char] String))
  (register format (Fn [&String Char] String))
)

(defmodule Int (defn prn [x] (Int.str x)))
(defmodule Long (defn prn [x] (Long.str x)))
(defmodule Float (defn prn [x] (Float.str x)))
(defmodule Double (defn prn [x] (Double.str x)))
(defmodule Bool (defn prn [x] (Bool.str x)))
(defmodule Char (defn prn [x] (Char.str x)))
(defmodule Array (defn prn [x] (Array.str x)))