Merge pull request #278 from puripuri2100/add-some-string-fun

Add some string functions

Author: puripuri2100

__test__/__snapshots__/regression.test.js.snap

@@ -9,6 +9,7 @@ exports[`Check compiler outputs 1`] = `
 [debug.log] 1
 [debug.log] ==== String ====
 [debug.log] abc
+[debug.log] a;b;c
 [debug.log] true
 [debug.log] spam
 [debug.log] ham
@@ -21,6 +22,17 @@ exports[`Check compiler outputs 1`] = `
 [debug.log] true
 [debug.log] true
 [debug.log] true
+[debug.log] true
+[debug.log] false
+[debug.log] false
+[debug.log] abc
+[debug.log] 
+[debug.log] abc   
+[debug.log]  abc
+[debug.log] GRüßE, JüRGEN
+[debug.log] grÜße, jÜrgen
+[debug.log] TiTle
+[debug.log] tiTle
 [debug.log] ==== List ====
 [debug.log] 
 [debug.log] 1

__test__/satysrc/generic.saty

@@ -54,13 +54,25 @@ let () = Debug.log (String.of-int (Ref.get r)) in % 1
 
 let () = Debug.log `==== String ====` in
 let () = Debug.log (String.concat [`a`; `b`; `c`;]) in
+let () = Debug.log (String.concat ?:(`;`) [`a`; `b`; `c`;]) in
 let () = Debug.log (String.of-bool (String.is-empty `  `)) in % true
 let _ = String.split-by (Char.make `;`) `spam;ham;eggs;` |> List.map Debug.log in
 let _ = String.to-list `abc` |> List.map (fun c -> (c |> String.of-char |> Debug.log)) in
 let () = String.(`a` < `b`) |> Bool.to-string |> Debug.log in % true
 let () = String.(`ab` < `ba`) |> Bool.to-string |> Debug.log in % true
 let () = String.(`aab` < `aba`) |> Bool.to-string |> Debug.log in % true
 let () = String.(`bbb` < `bbba`) |> Bool.to-string |> Debug.log in % true
+let () = String.contains `abc` `1abcdef` |> Bool.to-string |> Debug.log in % true
+let () = String.contains `abc` `abdef` |> Bool.to-string |> Debug.log in % false
+let () = String.contains `abc` `ef` |> Bool.to-string |> Debug.log in % false
+let () = String.trim #` abc   `# |> Debug.log in % |abc|
+let () = String.trim #`   `# |> Debug.log in % ||
+let () = String.trim-start #` abc   `# |> Debug.log in % |abc   |
+let () = String.trim-end #` abc   `# |> Debug.log in % | abc|
+let () = String.uppercase-ascii `Grüße, Jürgen` |> Debug.log in % GRüßE, JüRGEN
+let () = String.lowercase-ascii `GRÜßE, JÜRGEN` |> Debug.log in % grÜße, jÜrgen
+let () = String.capitalize-ascii `tiTle` |> Debug.log in % TiTle
+let () = String.uncapitalize-ascii `TiTle` |> Debug.log in % tiTle
 
 let () = Debug.log `==== List ====` in
 let lst = [1;3;2;4;5] in
@@ -358,7 +370,7 @@ let () = Debug.log `==== TreeSet ====` in
 % REMARK:
 % This test relies on the fact that the order of elements of a result from TreeSet.to-list is
 % level-order (BFS). If the implementation is changed, the following tests have to be updated.
-let p s = s |> TreeSet.to-list |> List.map String.of-int |> List.intersperse `,` |> String.concat |> Debug.log in
+let p s = s |> TreeSet.to-list |> List.map String.of-int |> List.intersperse `,` |> (fun l -> String.concat l) |> Debug.log in
 let s = TreeSet.empty in
 let () = p s in
 let s = TreeSet.of-list Int.ord [3;2;3;1] in

src/string.satyg

@@ -26,7 +26,7 @@ module String : sig
   val of-char : Char.t -> string
   val of-length : length -> string
   val append : string -> string -> string
-  val concat : string list -> string
+  val concat : string ?-> string list -> string
   val is-empty : string -> bool
   val starts-with : string -> string -> bool
   val ends-with : string -> string -> bool
@@ -38,6 +38,17 @@ module String : sig
   val split-by : Char.t -> string -> string list
   val lines : string -> string list
   val index : Char.t -> string -> int option
+  val make  : int -> Char.t -> string
+  val init  : int -> (int -> Char.t) -> string
+  val get   : int -> string -> Char.t option
+  val contains : string -> string -> bool
+  val trim       : string -> string
+  val trim-start : string -> string
+  val trim-end   : string -> string
+  val uppercase-ascii    : string -> string
+  val lowercase-ascii    : string -> string
+  val capitalize-ascii   : string -> string
+  val uncapitalize-ascii : string -> string
   % val byte-length : string -> int
   % val sub-bytes : int -> int -> string -> string
 end = struct
@@ -53,9 +64,22 @@ end = struct
   let of-char = Char.to-string
   let append s1 s2 = s1 ^ s2
 
-  let-rec concat xs = match xs with
-  | [] -> empty
-  | s :: xs -> s ^ concat xs
+
+
+  let concat ?:s xs =
+    let s =
+      match s with
+      | None -> empty
+      | Some(s) -> s
+    in
+    let-rec sub xs =
+      match xs with
+      | [] -> empty
+      | [x] -> x
+      | x :: xs -> x ^ s ^ sub xs
+    in
+    sub xs
+
 
   let is-empty s =
     equal s empty
@@ -71,13 +95,12 @@ end = struct
     (s-len >= p-len) &&&- (fun () -> equal (s |> sub (s-len - 1 - p-len) p-len) p)
 
   let to-list s =
-    let-rec go i acc = (match i with
-    | 0 -> acc
-    | _ -> go (i - 1) (Char.at (i - 1) s :: acc)) in
-    go (length s) []
+    s
+    |> string-explode
+    |> List.map Char.of-codepoint
 
   let of-list chars =
-    chars |> List.map Char.to-string |> concat
+    chars |> List.map Char.to-string |> (fun slst -> concat slst)
 
   let pow n s =
     let-rec go i acc = if i == n then acc else go (i + 1) (acc ^ s) in
@@ -103,6 +126,176 @@ end = struct
 
   let lines = split-by Char.newline
 
+
+  let-rec make n c =
+    if n <= 0 then
+      empty
+    else
+      Char.to-string c ^ make (n - 1) c
+
+
+  let init n f =
+    let-rec sub m f =
+      if m >= n then
+        empty
+      else
+        Char.to-string (f m) ^ sub (m + 1) f
+    in
+    sub 0 f
+
+
+  let get n str =
+    str
+    |> to-list
+    |> List.nth n
+
+
+
+
+  % Quick-Search
+  % こちらを参考に実装：https://www.m3tech.blog/entry/2020/09/28/120000
+  let contains s str =
+    % 検索する語と検索される語が先頭から一致するかどうかを判定する
+    % 一致しない場合は先頭の文字を渡す
+    let-rec search-and-get-next-char is-eq clst slst =
+      match (clst, slst) with
+      | ([], []) -> (is-eq, None)
+      | ([], s::_) -> (is-eq, Some(s))
+      | (_, []) -> (false, None)
+      | (c::cs, s::ss) -> (
+        if Char.equal c s && is-eq then
+          search-and-get-next-char true cs ss
+        else
+          search-and-get-next-char false cs ss
+      )
+    in
+
+    % 検索される語の先頭の文字が、検索する語の中で何番目にあたるかを調べる
+    % 検索される後の先頭の文字が、検索する語の中にない場合はNoneが返る
+    let-rec find-next-char-pos n n-opt c clst =
+      match clst with
+      | x::xs -> (
+        if Char.equal x c then
+          find-next-char-pos (n + 1) (Some n) c xs
+        else
+          find-next-char-pos (n + 1) None c xs
+      )
+      | [] -> n-opt
+    in
+
+    let-rec shift n lst =
+      if n <= 0 then
+        lst
+      else
+        match lst with
+        | [] -> []
+        | _::xs -> shift (n - 1) xs
+    in
+
+    let clst = to-list s in
+    let-rec sub l =
+      match search-and-get-next-char true clst l with
+      | (true, _) -> true
+      | (false, None) -> false
+      | (false, Some(c)) -> (
+        let n-opt = find-next-char-pos 0 None c clst in
+        let n =
+          match n-opt with
+          | Some(n) -> List.length clst - n
+          | None -> List.length clst + 1
+        in
+        let new-l = shift n l in
+        sub new-l
+      )
+    in
+    sub (to-list str)
+
+
+  let-rec space-len n clst =
+    match clst with
+    | c::xs -> (
+      if Char.is-space c then
+        space-len (n + 1) xs
+      else
+        n
+    )
+    | _ -> n
+
+  let trim str =
+    let len = length str in
+    let lst = to-list str in
+    let rev-lst = List.reverse lst in
+    let start-space-len = space-len 0 lst in
+    let end-space-len = space-len 0 rev-lst in
+    let len = len - start-space-len - end-space-len in
+    let len = if len < 0 then 0 else len in
+    sub start-space-len len str
+
+  let trim-start str =
+    let len = length str in
+    let lst = to-list str in
+    let start-space-len = space-len 0 lst in
+    let len = len - start-space-len in
+    sub start-space-len len str
+
+  let trim-end str =
+    let len = length str in
+    let lst = str |> to-list |> List.reverse in
+    let start-space-len = space-len 0 lst in
+    let len = len - start-space-len in
+    sub 0 len str
+
+
+  let uppercase-ascii str =
+    str
+    |> to-list
+    |> List.map (fun c -> (
+      let n = Char.to-codepoint c in
+      if 0x61 <= n && n <= 0x7A then
+        Char.of-codepoint (n - 0x20)
+      else
+        c
+    ))
+    |> of-list
+
+  let lowercase-ascii str =
+    str
+    |> to-list
+    |> List.map (fun c -> (
+      let n = Char.to-codepoint c in
+      if 0x41 <= n && n <= 0x5A then
+        Char.of-codepoint (n + 0x20)
+      else
+        c
+    ))
+    |> of-list
+
+  let capitalize-ascii str =
+    str
+    |> to-list
+    |> List.mapi (fun i c -> (
+      let n = Char.to-codepoint c in
+      if i == 0 && 0x61 <= n && n <= 0x7A then
+        Char.of-codepoint (n - 0x20)
+      else
+        c
+    ))
+    |> of-list
+
+  let uncapitalize-ascii str =
+    str
+    |> to-list
+    |> List.mapi (fun i c -> (
+      let n = Char.to-codepoint c in
+      if i == 0 && 0x41 <= n && n <= 0x5A then
+        Char.of-codepoint (n + 0x20)
+      else
+        c
+    ))
+    |> of-list
+
+
+
   let index c s =
     let cs = to-list s in
     let-rec aux cs acc = match cs with