(system-include "carp_string.h") (defmodule String (register = (Fn [&String &String] Bool)) (register > (Fn [&String &String] Bool)) (register < (Fn [&String &String] Bool)) (register append (Fn [&String &String] String)) (register delete (Fn [String] ())) (register copy (Fn [&String] String)) (register length (Fn [&String] Int)) (register cstr (Fn [&String] (Ptr Char))) (register from-cstr (Fn [(Ptr Char)] String)) (register str (Fn [&String] String)) (register prn (Fn [&String] String)) (register index-of (Fn [&String Char] Int)) (register index-of-from (Fn [&String Char Int] Int)) (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)) (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 [l (length inpt) str (String.allocate (* n l) \0)] (do (for [i 0 n] (string-set-at! &str (* i l) inpt)) str))) (doc pad-left "Pads the left of a string with len bytes using the padding pad.") (defn pad-left [len pad s] (let [x (Int.max 0 (- len (length s)))] (append &(from-chars &(Array.replicate x &pad)) s))) (doc pad-right "Pads the right of a string with len bytes using the padding pad.") (defn pad-right [len pad s] (let [x (Int.max 0 (- len (length 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 (length 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.= (length 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.subarray &(chars s) 0 a))) (doc suffix-string "Return the last `b` characters of the string `s`.") (defn suffix-string [s b] (from-chars &(Array.subarray &(chars s) b (length s)))) (doc starts-with? "Check if the string `s` begins with the string `sub`.") (defn starts-with? [s sub] (= sub &(prefix-string s (length sub)))) (doc ends-with? "Check if the string `s` ends with the string `sub`.") (defn ends-with? [s sub] (= sub &(suffix-string s (- (length s) (length sub))))) (doc zero "The empty string.") (defn zero [] @"") (doc sum-length "Returns the sum of lengths from an array of Strings.") (defn sum-length [strings] (let-do [sum 0 lstrings (Array.length strings)] (for [i 0 lstrings] (set! sum (+ sum (String.length (Array.unsafe-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.length calls, as we call it for each ;; string once here and once in sum-length. (let-do [j 0 lstrings (Array.length strings) result (String.allocate (sum-length strings) \ )] (for [i 0 lstrings] (let-do [str (Array.unsafe-nth strings i) len (String.length str)] (string-set-at! &result j str) (set! j (+ j len)))) result)) (doc join "Returns a new string which is the concatenation of the provided `strings` separated by string `sep`.") (defn join [sep strings] (let-do [j 0 lstrings (Array.length strings) num-seps (max 0 (- lstrings 1)) sep-length (String.length sep) seps-size (* num-seps sep-length) result (String.allocate (+ seps-size (sum-length strings)) \ )] (for [i 0 lstrings] (let-do [str (Array.unsafe-nth strings i) len (String.length str)] (when (> i 0) (do (string-set-at! &result j sep) (set! j (+ j sep-length)))) (string-set-at! &result j str) (set! j (+ j len)))) result)) (doc join-with-char "Returns a new string which is the concatenation of the provided `strings` separated by char `sep`.") (defn join-with-char [sep strings] ;; (= (join-with-char \ ["Hello" "world"]) (join " " ["Hello" "world"])) (let-do [j 0 lstrings (Array.length strings) sep-length (max 0 (- lstrings 1)) result (String.allocate (+ sep-length (sum-length strings)) \ )] (for [i 0 lstrings] (let-do [str (Array.unsafe-nth strings i) len (String.length str)] (when (> i 0) (do (string-set! &result j sep) (set! j (+ j 1)))) (string-set-at! &result j str) (set! j (+ j len)))) result)) (doc contains? "Checks whether the string `s` contains the character `c`.") (defn contains? [s c] (> (index-of s c) -1)) ) (defmodule StringCopy (defn str [s] (the String s)) (defn = [a b] (String.= &a &b)) (defn < [a b] (String.< &a &b)) (defn > [a b] (String.> &a &b)) (defn prn [s] (prn &(the String s))) (defn str [s] (str &(the String s))) ) (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 Byte (register str (Fn [Byte] String)) (register format (Fn [&String Byte] String)) (register from-string (λ [&String] Byte)) ) (defmodule Float (register str (Fn [Float] String)) (register format (Fn [&String Float] String)) (register from-string (λ [&String] Float)) ) (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)) (register from-string (λ [&String] Double)) ) (defmodule Char (register str (Fn [Char] String)) (register prn (Fn [Char] String)) (register format (Fn [&String Char] String)) ) (defmodule Int (defn prn [x] (Int.str x))) (defmodule Byte (defn prn [x] (Byte.str x))) (defmodule IntRef (defn prn [x] (Int.str @x)) (defn str [x] (Int.str @x)) ) (defmodule BoolRef (defn prn [x] (Bool.str @x)) (defn str [x] (Bool.str @x))) (defmodule ByteRef (defn prn [x] (Byte.str @x)) (defn str [x] (Byte.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 Array (defn prn [x] (Array.str x)))