mirror of
https://github.com/HigherOrderCO/Kind.git
synced 2024-09-11 17:56:48 +03:00
279 lines
7.8 KiB
Plaintext
279 lines
7.8 KiB
Plaintext
Parser
|
|
: ∀(A: *) *
|
|
= λA
|
|
∀(code: String)
|
|
(Parser.Result A)
|
|
|
|
// TODO: abstract error type
|
|
Parser.Result
|
|
: ∀(T: *)
|
|
*
|
|
= λT
|
|
$self
|
|
∀(P: ∀(x: (Parser.Result T)) *)
|
|
∀(done: ∀(code: String) ∀(value: T) (P (Parser.Result.done T code value)))
|
|
∀(fail: ∀(error: String) (P (Parser.Result.fail T error)))
|
|
(P self)
|
|
|
|
Parser.Result.done
|
|
: ∀(T: *)
|
|
∀(code: String)
|
|
∀(value: T)
|
|
(Parser.Result T)
|
|
= λT λcode λvalue
|
|
~λP λdone λfail
|
|
(done code value)
|
|
|
|
Parser.Result.fail
|
|
: ∀(T: *)
|
|
∀(error: String)
|
|
(Parser.Result T)
|
|
= λT λerror
|
|
~λP λdone λfail
|
|
(fail error)
|
|
|
|
Parser.Guard
|
|
: ∀(A: *) *
|
|
= λA (Pair (Parser Bool) (Parser A))
|
|
|
|
Parser.Guard.new
|
|
: ∀(A: *)
|
|
∀(guard: (Parser Bool))
|
|
∀(value: (Parser A))
|
|
(Parser.Guard A)
|
|
= λA (Pair.new (Parser Bool) (Parser A))
|
|
|
|
Parser.Guard.get
|
|
: ∀(A: *)
|
|
∀(p: (Parser.Guard A))
|
|
∀(P: *)
|
|
∀(f: ∀(a: (Parser Bool)) ∀(b: (Parser A)) P)
|
|
P
|
|
= λA (Pair.get (Parser Bool) (Parser A))
|
|
|
|
// Creates a guard that skips the condition.
|
|
Parser.Guard.pass
|
|
: ∀(A: *)
|
|
∀(then: (Parser A))
|
|
(Parser.Guard A)
|
|
= λA λthen
|
|
(Parser.Guard.new A (Parser.pure Bool Bool.true) then)
|
|
|
|
// Guards a parser with a simple text.
|
|
Parser.Guard.text
|
|
: ∀(A: *)
|
|
∀(text: String)
|
|
∀(then: (Parser A))
|
|
(Parser.Guard A)
|
|
= λA λtext λthen
|
|
(Parser.Guard.new A (Parser.test text) then)
|
|
|
|
Parser.pure
|
|
: ∀(A: *)
|
|
∀(value: A)
|
|
(Parser A)
|
|
= λA λvalue λcode
|
|
(Parser.Result.done A code value)
|
|
|
|
Parser.bind
|
|
: ∀(A: *)
|
|
∀(B: *)
|
|
∀(a: (Parser A))
|
|
∀(b: ∀(x: A) (Parser B))
|
|
(Parser B)
|
|
= λA λB λa λb
|
|
λcode
|
|
let P = λx ∀(b: ∀(x: A) (Parser B)) (Parser.Result B)
|
|
let done = λa.code λa.value λb (b a.value a.code)
|
|
let fail = λa.error λb (Parser.Result.fail B a.error)
|
|
(~(a code) P done fail b)
|
|
|
|
Parser.fail
|
|
: ∀(A: *)
|
|
∀(error: String)
|
|
(Parser A)
|
|
= λT λerror λcode
|
|
(Parser.Result.fail T error)
|
|
|
|
// Takes characters while a condition is true.
|
|
Parser.pick_while
|
|
: ∀(cond: ∀(chr: Char) Bool)
|
|
(Parser String)
|
|
= λcond λcode (Parser.pick_while.go cond (String.skip code))
|
|
|
|
Parser.pick_while.go
|
|
: ∀(cond: ∀(chr: Char) Bool)
|
|
(Parser String)
|
|
= λcond λcode
|
|
let P = λx(Parser.Result String)
|
|
let cons = λhead λtail
|
|
let P = λx ∀(head: Char) ∀(tail: String) (Parser.Result String)
|
|
let true = λhead λtail
|
|
let P = λx (Parser.Result String)
|
|
let done = λcode λvalue (Parser.Result.done String code (String.cons head value))
|
|
let fail = λerror (Parser.Result.fail String error)
|
|
(~(Parser.pick_while.go cond tail) P done fail)
|
|
let false = λhead λtail
|
|
(Parser.Result.done String tail String.nil)
|
|
(~(cond head) P true false head tail)
|
|
let nil =
|
|
(Parser.Result.done String String.nil String.nil)
|
|
(~code P cons nil)
|
|
|
|
// Parses a sequence of name-valid characters.
|
|
Parser.name
|
|
: (Parser String)
|
|
= (Parser.pick_while Char.is_name)
|
|
|
|
// Parses a sequence of oper-valid characters.
|
|
Parser.oper
|
|
: (Parser String)
|
|
= (Parser.pick_while Char.is_oper)
|
|
|
|
// Checks if the next characteres match given text.
|
|
Parser.test
|
|
: ∀(test: String)
|
|
(Parser Bool)
|
|
= λtest λcode
|
|
// Gets the first expected character.
|
|
let P = λx ∀(code: String) (Parser.Result Bool)
|
|
let cons = λtest.head λtest.tail λcode
|
|
// Gets the first detected character.
|
|
let P = λx (Parser.Result Bool)
|
|
let cons = λcode.head λcode.tail
|
|
// Checks if expected == detected.
|
|
let P = λx ∀(code.head: Char) ∀(code.tail: String) (Parser.Result Bool)
|
|
let true = λcode.head λcode.tail
|
|
// If so, parses the next character and reconstructs the original code.
|
|
let P = λx(Parser.Result Bool)
|
|
let done = λcode λvalue (Parser.Result.done Bool (String.cons code.head code) value)
|
|
let fail = λerror (Parser.Result.fail Bool error)
|
|
(~(Parser.test test.tail code.tail) P done fail)
|
|
let false = λcode.head λcode.tail
|
|
// Otherwise, returns false and reconstructs the original code.
|
|
(Parser.Result.done Bool (String.cons code.head code.tail) Bool.false)
|
|
((~(Char.equal test.head code.head) P true false) code.head code.tail)
|
|
let nil = (Parser.Result.done Bool String.nil Bool.false)
|
|
(~code P cons nil)
|
|
let nil = λcode (Parser.Result.done Bool code Bool.true)
|
|
(~test P cons nil code)
|
|
|
|
// Parses an exact text.
|
|
// - If successful, consumes text.
|
|
// - Otherwise, throws.
|
|
Parser.text
|
|
: ∀(text: String)
|
|
(Parser Unit)
|
|
= λtext
|
|
(Parser.bind Bool Unit (Parser.test text) λsuccess
|
|
(Bool.if success (Parser Unit)
|
|
// then
|
|
(Parser.bind String Unit (Parser.take (String.length text)) λx
|
|
(Parser.pure Unit Unit.one))
|
|
// else
|
|
(Parser.fail Unit "error")))
|
|
|
|
// Repeats a parser N times.
|
|
Parser.repeat
|
|
: ∀(n: Nat)
|
|
∀(A: *)
|
|
∀(p: (Parser A))
|
|
(Parser (List A))
|
|
= λn λA λp
|
|
let P = λx (Parser (List A))
|
|
let succ = λn.pred
|
|
(Parser.bind A (List A) p λhead
|
|
(Parser.bind (List A) (List A) (Parser.repeat n.pred A p) λtail
|
|
(Parser.pure (List A) (List.cons A head tail))))
|
|
let zero = (Parser.pure (List A) (List.nil A))
|
|
(~n P succ zero)
|
|
|
|
// Picks a single character.
|
|
Parser.pick
|
|
: (Parser Char)
|
|
= λcode
|
|
let P = λx(Parser.Result Char)
|
|
let cons = λhead λtail (Parser.Result.done Char tail head)
|
|
let nil = (Parser.Result.fail Char "empty")
|
|
(~code P cons nil)
|
|
|
|
// Takes a string.
|
|
Parser.take
|
|
: ∀(n: Nat)
|
|
(Parser String)
|
|
= λn (Parser.repeat n Char Parser.pick)
|
|
|
|
// Attempts to parse one of multiple variants.
|
|
// - Each variant is guarded by a (Parser Bool).
|
|
// - If the guard succeeds, we parse that variant.
|
|
// - Otherwise, we try the next variant.
|
|
Parser.variant
|
|
: ∀(A: *)
|
|
∀(variants: (List (Parser.Guard A)))
|
|
(Parser A)
|
|
= λA λvariants
|
|
let P = λx(Parser A)
|
|
let cons = λvariant λothers
|
|
(Pair.get (Parser Bool) (Parser A) variant (Parser A) λguard λparser
|
|
(Parser.bind Bool A guard λsuccess
|
|
(Bool.if success (Parser A) parser (Parser.variant A others))))
|
|
let nil = (Parser.fail A "error")
|
|
(~variants P cons nil)
|
|
|
|
// Parses a single character, escape-sequence-aware.
|
|
// TODO: parse \u{...} escape sequences
|
|
Parser.char
|
|
: (Parser Char)
|
|
= let P = (List (Parser.Guard Char))
|
|
let cons = λhead λtail
|
|
let escaped = (~head λx(Parser.Guard Char) λnorm λspec
|
|
let guard = (String.cons Char.slash (String.cons norm String.nil))
|
|
let value = (Parser.pure Char spec)
|
|
(Parser.Guard.text Char guard value))
|
|
(List.cons (Parser.Guard Char) escaped tail)
|
|
let nil =
|
|
(List.cons (Parser.Guard Char) (Parser.Guard.pass Char Parser.pick)
|
|
(List.nil (Parser.Guard Char)))
|
|
(Parser.variant Char
|
|
(List.fold (Pair Char Char) Char.escapes P cons nil))
|
|
|
|
// Applies a function to a parsed value.
|
|
Parser.map
|
|
: ∀(A: *)
|
|
∀(B: *)
|
|
∀(f: ∀(a: A) B)
|
|
∀(p: (Parser A))
|
|
(Parser B)
|
|
= λA λB λf λp λcode
|
|
let P = λx(Parser.Result B)
|
|
let done = λcode λvalue (Parser.Result.done B code (f value))
|
|
let fail = λerror (Parser.Result.fail B error)
|
|
(~(p code) P done fail)
|
|
|
|
// Parses repeatedly until a terminator parser succeeds.
|
|
Parser.until
|
|
: ∀(A: *)
|
|
∀(until: (Parser Unit))
|
|
∀(parse: (Parser A))
|
|
(Parser (List A))
|
|
= λA λuntil λparse
|
|
(Parser.map (List.Concatenator A) (List A) (List.Concatenator.build A)
|
|
(Parser.until.go A until parse λx(x)))
|
|
|
|
Parser.until.go
|
|
: ∀(A: *)
|
|
∀(until: (Parser Unit))
|
|
∀(parse: (Parser A))
|
|
∀(terms: (List.Concatenator A))
|
|
(Parser (List.Concatenator A))
|
|
= λA λuntil λparse λterms λcode
|
|
let P = λx(Parser.Result (List.Concatenator A))
|
|
let fail = λcode
|
|
let P = λx(Parser.Result (List.Concatenator A))
|
|
let done = λcode λvalue (Parser.until.go A until parse λx(terms (List.cons A value x)) code)
|
|
let fail = λcode (Parser.Result.fail (List.Concatenator A) code)
|
|
(~(parse code) P done fail)
|
|
let done = λcode λvalue
|
|
(Parser.Result.done (List.Concatenator A) code terms)
|
|
(~(until code) P done fail)
|