Kind/book/Parser.kind2

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)