aoc2023/lib/string.quox

load "bool.quox"
load "list.quox"
load "maybe.quox"
load "either.quox"

namespace char {

postulate0 Char : ★

#[compile-scheme "(lambda (c) c)"]
postulate dup : Char → [ω.Char]

#[compile-scheme "char->integer"]
postulate to-ℕ : Char → ℕ

#[compile-scheme "integer->char"]
postulate from-ℕ : ℕ → Char

def space   = from-ℕ 0x20
def tab     = from-ℕ 0x09
def newline = from-ℕ 0x0a

def test-via-ℕ : (ω.ℕ → ω.ℕ → Bool) → (ω.Char → ω.Char → Bool) =
  λ p c d ⇒ p (to-ℕ c) (to-ℕ d)
def lt = test-via-ℕ nat.lt
def eq = test-via-ℕ nat.eq
def gt = test-via-ℕ nat.gt
def le = test-via-ℕ nat.le
def ne = test-via-ℕ nat.ne
def ge = test-via-ℕ nat.ge

postulate0 eq-iff-nat : (c d : Char) → Iff (c ≡ d : Char) (to-ℕ c ≡ to-ℕ d : ℕ)

def eq? : DecEq Char =
  λ c d ⇒
  let0 Ty = (c ≡ d : Char) ∷ ★ in
  dec.elim (to-ℕ c ≡ to-ℕ d : ℕ) (λ _ ⇒ Dec Ty)
    (λ y ⇒ Yes Ty ((snd (eq-iff-nat c d)) y))
    (λ n ⇒ No  Ty (λ y ⇒ n ((fst (eq-iff-nat c d)) y)))
    (nat.eq? (to-ℕ c) (to-ℕ d))

def ws? : ω.Char → Bool =
  λ c ⇒ bool.or (bool.or (eq c space) (eq c tab)) (eq c newline)

def digit? : ω.Char → Bool =
  λ c ⇒ bool.and (ge c (from-ℕ 0x30)) (le c (from-ℕ 0x39))

def digit-val : Char → Maybe ℕ =
  λ c ⇒ case dup c return Maybe ℕ of { [c] ⇒
    bool.if (Maybe ℕ) (digit? c)
      (Just ℕ (nat.minus (to-ℕ c) 0x30))
      (Nothing ℕ)
  }

}

def0 Char = char.Char

namespace string {

#[compile-scheme "string->list"]
postulate to-scheme-list : String → list.SchemeList Char

def to-list : String → List Char =
  λ str ⇒ list.from-scheme Char (to-scheme-list str)

#[compile-scheme "list->string"]
postulate from-scheme-list : list.SchemeList Char → String

def from-list : List Char → String =
  λ cs ⇒ from-scheme-list (list.to-scheme Char cs)

def foldl : 0.(A : ★) → A → ω.(A → Char → A) → String → A =
  λ A z f str ⇒ list.foldl Char A z f (to-list str)

def split : ω.(ω.Char → Bool) → ω.String → List String =
  λ p str ⇒
    list.map (List Char) String from-list
      (list.split Char p (to-list str))

def break : ω.(ω.Char → Bool) → ω.String → String × String =
  λ p str ⇒
  letω pair = list.break Char p (to-list str) in
  (from-list (fst pair), from-list (snd pair))

def reverse : String → String =
  λ str ⇒ from-list (list.reverse Char (to-list str))

#[compile-scheme "(lambda% (a b) (if (string=? a b) 'true 'false))"]
postulate eq : ω.String → ω.String → Bool

def null : ω.String → Bool = eq ""
def not-null : ω.String → Bool = λ s ⇒ bool.not (null s)

#[compile-scheme "(lambda (str) str)"]
postulate dup : String → [ω.String]

postulate0 dup-ok : (str : String) → dup str ≡ [str] : [ω.String]

def dup! : (str : String) → Dup String str =
  dup-from-parts String dup dup-ok


def to-ℕ : String → Maybe ℕ =
  letω add-digit : Maybe ℕ → ℕ → Maybe ℕ =
    maybe.fold ℕ (ℕ → Maybe ℕ) (λ d ⇒ Just ℕ d)
      (λ n d ⇒ Just ℕ (nat.plus (nat.times 10 n) d)) in
  letω drop : Maybe ℕ → Maybe ℕ =
    maybe.fold ℕ (Maybe ℕ) (Nothing ℕ)
      (λ n ⇒ nat.drop (Maybe ℕ) n (Nothing ℕ)) in
  letω add-digit-c : Maybe ℕ → Char → Maybe ℕ =
    λ acc c ⇒
      maybe.fold ℕ (Maybe ℕ → Maybe ℕ) drop (λ n acc ⇒ add-digit acc n)
        (char.digit-val c) acc in
  λ str ⇒
    case dup str return Maybe ℕ of { [str] ⇒
      bool.if (Maybe ℕ) (not-null str)
        (foldl (Maybe ℕ) (Just ℕ 0) add-digit-c str)
        (Nothing ℕ)
    }

def to-ℕ-or-0 : String → ℕ =
  λ str ⇒ maybe.fold ℕ ℕ 0 (λ x ⇒ x) (to-ℕ str)


#[compile-scheme
 "(lambda% (yes no str)
    (let [(len (string-length str))]
      (if (= len 0)
        no
        (let [(first (string-ref str 0))
              (rest  (substring str 1 len))]
          (% yes first rest)))))"]
postulate uncons' : 0.(A : ★) → ω.A → ω.(Char → String → A) → String → A

def uncons : String → Maybe (Char × String) =
  let0 Ret : ★ = Char × String in
  uncons' (Maybe Ret) (Nothing Ret) (λ c s ⇒ Just Ret (c, s))

}