VSL - The prelude.string Structure
# Copyright 2011 Petter Urkedal
#
# This file is part of the Viz Standard Library <http://www.vizlang.org/>.
#
# The Viz Standard Library (VSL) is free software: you can redistribute it
# and/or modify it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation, either version 3 of the License,
# or (at your option) any later version.
#
# The VSL is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
# more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with the VSL. If not, see <http://www.gnu.org/licenses/>.
open prereq
open effect
type t := string
#?ffoc include compat.ocaml_unicode.string
in buf
#?ffoc include compat.ocaml_unicode.string_buf
let of_char ch be init 1 (_ ↦ ch)
let show s be observe (that : ∀ψ. effect ψ α) which!
let buf do buf.create
let! put_escaped
at c"\\" do buf.put_string buf "\\\\"
at c"\t" do buf.put_string buf "\\t"
at c"\n" do buf.put_string buf "\\n"
at c"\r" do buf.put_string buf "\\r"
# FIXME: Use char.is_print.
at ch do buf.put_char buf ch
do buf.put_char buf c"\""
do iter put_escaped s
do buf.put_char buf c"\""
do buf.contents buf
let cat x y
let nx be length x
let n be nx + length y
be init n (i ↦ (i < nx ⇒ get i x; get (i - nx) y))
let cat_list xs be observe (that : ∀ψ. effect ψ α) which!
let buf do buf.create
do list.iter (buf.put_string buf) xs
do buf.contents buf
let join s
at [] be ""
at [x; xs] be observe (that : ∀ψ. effect ψ α) which!
let buf do buf.create
do buf.put_string buf x
do list.iter (x ↦ buf.put_string buf s >> buf.put_string buf x) xs
do buf.contents buf
let tile n s
if n ≤ 0 be ""
be observe (that : ∀ψ. effect ψ α) which!
let buf do buf.create
let! loop at 0 be ()
at n do buf.put_string buf s >> loop (n - 1)
do loop n
do buf.contents buf
let slice i j x
assert 0 ≤ i ≤ j ≤ length x
be init (j - i) (k ↦ get (i + k) x)
let as_list x
let collect_upto n accu
if n = 0 be accu
else be collect_upto (n - 1) [get (n - 1) x; accu]
be collect_upto (length x) []
let of_list xs be observe (that : ∀ψ. effect ψ α) which!
let buf do buf.create
do list.iter (buf.put_char buf) xs
do buf.contents buf
let fold f x
let n be length x
let fold_from i accu
if i ≥ n be accu
be fold_from (i + 1) (f (get i x) accu)
be fold_from 0
let foldr f x
let foldr_from i accu
if i < 0 be accu
be foldr_from (i - 1) (f (get i x) accu)
be foldr_from (length x - 1)
let! iter f x
let n be length x
let! iter_from i
if i ≥ n be ()
do f (get i x)
do iter_from (i + 1)
do iter_from 0
let map f x be init (length x) (i ↦ f (get i x))
let mapi f x be init (length x) (i ↦ f i (get i x))
let for_all f x
let n be length x
let true_above i be i ≥ n ∨ f (get i x) ∧ true_above (i + 1)
be true_above 0
let for_some f x
let n be length x
let true_above i be i < n ∧ (f (get i x) ∨ true_above (i + 1))
be true_above 0
let starts_with x y
let n be length x
if n > length y be false
let loop i be i = n ∨ get i x = get i y ∧ loop (i + 1)
be loop 0
let ends_with x y
let n be length x
let j be length y - n
if j < 0 be false
let loop i be i = n ∨ get i x = get (i + j) y ∧ loop (i + 1)
be loop 0
let contains_char c x
let n be length x
let loop i be i < n ∧ (get i x = c ∨ loop (i + 1))
be loop 0
let contains_sub x y
let n be length x
let j_max be length y - n
let try_from j
if j > j_max be false
let ok_from i be i ≥ n ∨ get i x = get (j + i) y ∧ ok_from (i + 1)
be ok_from 0 ∨ try_from (j + 1)
be try_from 0
let count_char ch s
let loop i accu
if i < 0 be accu
be loop (i - 1) (get i s = ch ⇒ accu + 1; accu)
be loop (length s - 1) 0
let count_for f s
let loop i accu
if i < 0 be accu
be loop (i - 1) (f (get i s) ⇒ accu + 1; accu)
be loop (length s - 1) 0
let skip_while f s i
assert 0 ≤ i ≤ length s
be i < length s ∧ f (get i s) ⇒ skip_while f s (i + 1); i
let rskip_while f s i
assert 0 ≤ i ≤ length s
be i > 0 ∧ f (get (i - 1) s) ⇒ rskip_while f s (i - 1); i
let skip_to_char ch s i
assert 0 ≤ i ≤ length s
be i < length s ∧ ¬ char.eq ch (get i s) ⇒ skip_to_char ch s (i + 1); i
let rskip_to_char ch s i
assert 0 ≤ i ≤ length s
be i > 0 ∧ ¬ char.eq ch (get (i - 1) s) ⇒ rskip_to_char ch s (i - 1); i
let skip_space be skip_while char.is_space
let rskip_space be rskip_while char.is_space
let skip_to_sub s r j
let n be length s
let j_max be length r - n
let try_from j
if j > j_max be length r
let ok_from i be i ≥ n ∨ get i s = get (j + i) r ∧ ok_from (i + 1)
if ok_from 0 be j
be try_from (j + 1)
be try_from j
let scan_while f s i
let j be skip_while f s i
be (slice i j s, j)
let rscan_while f s i
let j be rskip_while f s i
be (slice j i s, j)
let scan_to_char ch s i
let j be skip_to_char ch s i
be (slice i j s, j)
let rscan_to_char ch s i
let j be rskip_to_char ch s i
be (slice j i s, j)
let scan_to_sub su s i
let j be skip_to_sub su s i
be (slice i j s, j)
let strip s
let i be skip_space s 0
let j be rskip_space s (length s)
be i < j ⇒ slice i j s; ""
let strip_left s
let i be skip_space s 0
be slice i (length s) s
let strip_right s
let j be rskip_space s (length s)
be slice 0 j s
let split_where f s
let loop j accu
if j < 0 be accu
if j = 0 be [""; accu]
let i be rskip_while (¬* f) s j
be loop (i - 1) [slice i j s; accu]
be loop (length s) []
let split_on ch be split_where (char.eq ch)
let csplit_where f s
let loop j accu
if j = 0 be accu
let i be rskip_while (¬* f) s j
be loop (rskip_while f s i) [slice i j s; accu]
be loop (rskip_while f s (length s)) []
let csplit_on_space be csplit_where char.is_space