141 lines
4.1 KiB
Plaintext
141 lines
4.1 KiB
Plaintext
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))
|
||
|
||
}
|