2018-02-27 16:14:14 +03:00
|
|
|
(system-include "carp_string.h")
|
|
|
|
|
2017-06-26 12:15:03 +03:00
|
|
|
(defmodule String
|
2017-12-12 14:57:13 +03:00
|
|
|
|
2017-10-20 18:00:47 +03:00
|
|
|
(register = (Fn [&String &String] Bool))
|
2018-06-26 09:00:33 +03:00
|
|
|
(register > (Fn [&String &String] Bool))
|
|
|
|
(register < (Fn [&String &String] Bool))
|
2018-05-20 07:04:47 +03:00
|
|
|
(register append (Fn [&String &String] String))
|
2017-10-20 18:00:47 +03:00
|
|
|
(register delete (Fn [String] ()))
|
|
|
|
(register copy (Fn [&String] String))
|
2018-05-20 10:57:51 +03:00
|
|
|
(register length (Fn [&String] Int))
|
2017-10-20 18:00:47 +03:00
|
|
|
(register cstr (Fn [&String] (Ptr Char)))
|
2020-01-14 00:47:09 +03:00
|
|
|
(register from-cstr (Fn [(Ptr Char)] String))
|
2017-10-20 18:00:47 +03:00
|
|
|
(register str (Fn [&String] String))
|
2018-02-06 20:37:15 +03:00
|
|
|
(register prn (Fn [&String] String))
|
2018-05-20 11:25:13 +03:00
|
|
|
(register index-of (Fn [&String Char] Int))
|
2018-05-20 11:41:36 +03:00
|
|
|
(register index-of-from (Fn [&String Char Int] Int))
|
2017-12-18 18:19:29 +03:00
|
|
|
(register char-at (Fn [&String Int] Char))
|
2017-10-20 18:00:47 +03:00
|
|
|
(register chars (Fn [&String] (Array Char)))
|
2018-03-12 16:56:05 +03:00
|
|
|
(register from-chars (Fn [&(Array Char)] String))
|
2017-12-04 17:25:18 +03:00
|
|
|
(register tail (λ [(Ref String)] String))
|
2017-12-30 22:16:31 +03:00
|
|
|
(register format (Fn [&String &String] String))
|
2018-05-19 09:49:48 +03:00
|
|
|
(register string-set! (Fn [&String Int Char] ()))
|
2018-05-20 06:53:30 +03:00
|
|
|
(register string-set-at! (Fn [&String Int &String] ()))
|
2018-05-20 11:47:27 +03:00
|
|
|
(register allocate (Fn [Int Char] String))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc head "Returns the character at start of string.")
|
2017-12-18 18:06:17 +03:00
|
|
|
(defn head [s]
|
|
|
|
(char-at s 0))
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc repeat "Returns a new string which is `inpt` repeated `n` times.")
|
2017-10-20 18:00:47 +03:00
|
|
|
(defn repeat [n inpt]
|
2019-10-28 20:13:40 +03:00
|
|
|
(let [l (length inpt)
|
|
|
|
str (String.allocate (* n l) \0)]
|
2017-10-20 18:00:47 +03:00
|
|
|
(do
|
|
|
|
(for [i 0 n]
|
2019-10-28 20:13:40 +03:00
|
|
|
(string-set-at! &str (* i l) inpt))
|
2017-12-23 16:30:45 +03:00
|
|
|
str)))
|
2017-12-04 00:30:48 +03:00
|
|
|
|
2018-06-15 17:38:34 +03:00
|
|
|
(doc pad-left "Pads the left of a string with len bytes using the padding pad.")
|
2017-11-29 23:33:35 +03:00
|
|
|
(defn pad-left [len pad s]
|
2018-05-20 10:57:51 +03:00
|
|
|
(let [x (Int.max 0 (- len (length s)))]
|
2018-05-20 07:04:47 +03:00
|
|
|
(append &(from-chars &(Array.replicate x &pad)) s)))
|
2017-11-29 23:33:35 +03:00
|
|
|
|
2018-06-15 17:38:34 +03:00
|
|
|
(doc pad-right "Pads the right of a string with len bytes using the padding pad.")
|
2017-11-29 23:33:35 +03:00
|
|
|
(defn pad-right [len pad s]
|
2018-05-20 10:57:51 +03:00
|
|
|
(let [x (Int.max 0 (- len (length s)))]
|
2018-05-20 07:04:47 +03:00
|
|
|
(append s &(from-chars &(Array.replicate x &pad)))))
|
2017-12-18 17:46:25 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc count-char "Returns the number of occurrences of `c` in the string `s`.")
|
2017-12-18 17:46:25 +03:00
|
|
|
(defn count-char [s c]
|
|
|
|
(let-do [n 0]
|
2018-05-20 10:57:51 +03:00
|
|
|
(for [i 0 (length s)]
|
2017-12-18 18:19:29 +03:00
|
|
|
(when (= c (char-at s i))
|
2018-02-02 09:19:10 +03:00
|
|
|
(set! n (Int.inc n))))
|
2017-12-18 17:46:25 +03:00
|
|
|
n))
|
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc reverse "Produce a new string which is `s` reversed.")
|
2017-12-18 17:46:25 +03:00
|
|
|
(defn reverse [s]
|
2018-03-12 16:56:05 +03:00
|
|
|
(from-chars &(Array.reverse (chars s))))
|
2017-11-29 23:33:35 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc empty? "Check if the string is the empty string.")
|
2017-11-29 23:33:35 +03:00
|
|
|
(defn empty? [s]
|
2018-05-20 10:57:51 +03:00
|
|
|
(Int.= (length s) 0))
|
2017-12-28 20:10:38 +03:00
|
|
|
|
2018-01-02 20:13:52 +03:00
|
|
|
(defn substring [s a b]
|
2018-03-12 16:56:05 +03:00
|
|
|
(from-chars &(Array.subarray &(chars s) a b)))
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc prefix-string "Return the first `a` characters of the string `s`.")
|
2018-01-02 20:13:52 +03:00
|
|
|
(defn prefix-string [s a]
|
2018-11-01 17:55:51 +03:00
|
|
|
(from-chars &(Array.subarray &(chars s) 0 a)))
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc suffix-string "Return the last `b` characters of the string `s`.")
|
2018-01-02 20:13:52 +03:00
|
|
|
(defn suffix-string [s b]
|
2018-11-01 17:55:51 +03:00
|
|
|
(from-chars &(Array.subarray &(chars s) b (length s))))
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc starts-with? "Check if the string `s` begins with the string `sub`.")
|
2018-01-02 20:13:52 +03:00
|
|
|
(defn starts-with? [s sub]
|
2018-05-20 10:57:51 +03:00
|
|
|
(= sub &(prefix-string s (length sub))))
|
2018-01-02 20:13:52 +03:00
|
|
|
|
2018-06-15 17:38:34 +03:00
|
|
|
(doc ends-with? "Check if the string `s` ends with the string `sub`.")
|
2018-01-02 20:13:52 +03:00
|
|
|
(defn ends-with? [s sub]
|
2018-05-20 10:57:51 +03:00
|
|
|
(= sub &(suffix-string s (- (length s) (length sub)))))
|
2018-01-29 00:54:59 +03:00
|
|
|
|
2018-05-19 06:09:54 +03:00
|
|
|
(doc zero "The empty string.")
|
2018-01-29 00:54:59 +03:00
|
|
|
(defn zero [] @"")
|
2018-03-11 17:09:30 +03:00
|
|
|
|
2018-05-20 10:57:51 +03:00
|
|
|
(doc sum-length "Returns the sum of lengths from an array of Strings.")
|
|
|
|
(defn sum-length [strings]
|
2018-05-20 09:48:20 +03:00
|
|
|
(let-do [sum 0
|
2018-05-20 10:57:51 +03:00
|
|
|
lstrings (Array.length strings)]
|
2018-05-20 09:48:20 +03:00
|
|
|
(for [i 0 lstrings]
|
2019-10-31 12:23:23 +03:00
|
|
|
(set! sum (+ sum (String.length (Array.unsafe-nth strings i)))))
|
2018-05-20 09:48:20 +03:00
|
|
|
sum))
|
|
|
|
|
2018-05-19 09:02:03 +03:00
|
|
|
(doc concat "Returns a new string which is the concatenation of the provided `strings`.")
|
|
|
|
(defn concat [strings]
|
2018-05-20 09:48:20 +03:00
|
|
|
;; This is using a StringBuilder pattern to only perform one allocation and
|
|
|
|
;; to only copy each of the incoming strings once.
|
2018-05-20 10:57:51 +03:00
|
|
|
;; This currently performs wasted String.length calls, as we call it for each
|
|
|
|
;; string once here and once in sum-length.
|
2018-05-20 09:48:20 +03:00
|
|
|
(let-do [j 0
|
2018-05-20 10:57:51 +03:00
|
|
|
lstrings (Array.length strings)
|
|
|
|
result (String.allocate (sum-length strings) \ )]
|
2018-05-20 09:56:51 +03:00
|
|
|
(for [i 0 lstrings]
|
2019-10-31 12:23:23 +03:00
|
|
|
(let-do [str (Array.unsafe-nth strings i)
|
2018-05-20 10:57:51 +03:00
|
|
|
len (String.length str)]
|
2018-05-20 09:56:51 +03:00
|
|
|
(string-set-at! &result j str)
|
|
|
|
(set! j (+ j len))))
|
|
|
|
result))
|
2018-05-19 06:17:06 +03:00
|
|
|
|
2018-05-20 10:11:26 +03:00
|
|
|
(doc join "Returns a new string which is the concatenation of the provided `strings` separated by string `sep`.")
|
2018-05-19 09:02:03 +03:00
|
|
|
(defn join [sep strings]
|
2018-05-20 10:11:26 +03:00
|
|
|
(let-do [j 0
|
2018-05-20 10:57:51 +03:00
|
|
|
lstrings (Array.length strings)
|
2019-09-10 22:49:00 +03:00
|
|
|
num-seps (max 0 (- lstrings 1))
|
2019-09-16 21:22:01 +03:00
|
|
|
sep-length (String.length sep)
|
2018-05-20 10:11:26 +03:00
|
|
|
seps-size (* num-seps sep-length)
|
2018-05-20 10:57:51 +03:00
|
|
|
result (String.allocate (+ seps-size (sum-length strings)) \ )]
|
2018-05-20 10:11:26 +03:00
|
|
|
(for [i 0 lstrings]
|
2019-10-31 12:23:23 +03:00
|
|
|
(let-do [str (Array.unsafe-nth strings i)
|
2018-05-20 10:57:51 +03:00
|
|
|
len (String.length str)]
|
2018-05-20 10:11:26 +03:00
|
|
|
(when (> i 0)
|
|
|
|
(do
|
2019-09-16 21:22:01 +03:00
|
|
|
(string-set-at! &result j sep)
|
2018-05-20 10:11:26 +03:00
|
|
|
(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
|
2018-05-20 10:57:51 +03:00
|
|
|
lstrings (Array.length strings)
|
2019-09-10 22:49:00 +03:00
|
|
|
sep-length (max 0 (- lstrings 1))
|
2018-05-20 10:57:51 +03:00
|
|
|
result (String.allocate (+ sep-length (sum-length strings)) \ )]
|
2018-05-20 10:11:26 +03:00
|
|
|
(for [i 0 lstrings]
|
2019-10-31 12:23:23 +03:00
|
|
|
(let-do [str (Array.unsafe-nth strings i)
|
2018-05-20 10:57:51 +03:00
|
|
|
len (String.length str)]
|
2018-05-19 06:17:06 +03:00
|
|
|
(when (> i 0)
|
2018-05-20 10:11:26 +03:00
|
|
|
(do
|
|
|
|
(string-set! &result j sep)
|
|
|
|
(set! j (+ j 1))))
|
|
|
|
(string-set-at! &result j str)
|
|
|
|
(set! j (+ j len))))
|
2018-03-11 17:09:30 +03:00
|
|
|
result))
|
2019-03-23 20:41:08 +03:00
|
|
|
|
|
|
|
(doc contains? "Checks whether the string `s` contains the character `c`.")
|
|
|
|
(defn contains? [s c] (> (index-of s c) -1))
|
2017-11-29 23:33:35 +03:00
|
|
|
)
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2017-12-22 13:17:19 +03:00
|
|
|
(defmodule StringCopy
|
2018-06-15 17:38:34 +03:00
|
|
|
(defn str [s] (the String s))
|
|
|
|
|
2017-12-22 13:17:19 +03:00
|
|
|
(defn = [a b]
|
|
|
|
(String.= &a &b))
|
2017-12-19 19:53:27 +03:00
|
|
|
|
2018-06-26 10:20:39 +03:00
|
|
|
(defn < [a b]
|
|
|
|
(String.< &a &b))
|
|
|
|
|
|
|
|
(defn > [a b]
|
|
|
|
(String.> &a &b))
|
2018-08-07 10:30:06 +03:00
|
|
|
|
|
|
|
(defn prn [s]
|
|
|
|
(prn &(the String s)))
|
|
|
|
|
|
|
|
(defn str [s]
|
|
|
|
(str &(the String s)))
|
2017-12-22 13:17:19 +03:00
|
|
|
)
|
2017-10-20 18:00:47 +03:00
|
|
|
|
2018-02-27 16:49:06 +03:00
|
|
|
(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))
|
|
|
|
)
|
|
|
|
|
2019-10-24 12:23:38 +03:00
|
|
|
(defmodule Byte
|
|
|
|
(register str (Fn [Byte] String))
|
|
|
|
(register format (Fn [&String Byte] String))
|
|
|
|
(register from-string (λ [&String] Byte))
|
|
|
|
)
|
|
|
|
|
2018-02-27 16:49:06 +03:00
|
|
|
(defmodule Float
|
|
|
|
(register str (Fn [Float] String))
|
|
|
|
(register format (Fn [&String Float] String))
|
2020-01-29 13:41:06 +03:00
|
|
|
(register from-string (λ [&String] Float))
|
2018-02-27 16:49:06 +03:00
|
|
|
)
|
|
|
|
|
|
|
|
(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))
|
2020-01-29 13:41:06 +03:00
|
|
|
(register from-string (λ [&String] Double))
|
2018-02-27 16:49:06 +03:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmodule Char
|
|
|
|
(register str (Fn [Char] String))
|
2018-05-20 19:28:45 +03:00
|
|
|
(register prn (Fn [Char] String))
|
2018-02-27 16:49:06 +03:00
|
|
|
(register format (Fn [&String Char] String))
|
|
|
|
)
|
2018-02-27 17:30:22 +03:00
|
|
|
|
|
|
|
(defmodule Int (defn prn [x] (Int.str x)))
|
2019-10-24 13:08:49 +03:00
|
|
|
(defmodule Byte (defn prn [x] (Byte.str x)))
|
2018-12-12 09:20:20 +03:00
|
|
|
(defmodule IntRef
|
|
|
|
(defn prn [x] (Int.str @x))
|
|
|
|
(defn str [x] (Int.str @x))
|
2019-06-14 16:24:25 +03:00
|
|
|
)
|
|
|
|
|
|
|
|
(defmodule BoolRef
|
|
|
|
(defn prn [x] (Bool.str @x))
|
|
|
|
(defn str [x] (Bool.str @x)))
|
2018-12-12 09:20:20 +03:00
|
|
|
|
2019-10-24 13:08:49 +03:00
|
|
|
(defmodule ByteRef
|
|
|
|
(defn prn [x] (Byte.str @x))
|
|
|
|
(defn str [x] (Byte.str @x))
|
|
|
|
)
|
|
|
|
|
2018-02-27 17:30:22 +03:00
|
|
|
(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)))
|