(* A given rule in a grammar is a list of either terminals or
 * nonterminals... *)
type element =
  | Nonterm of string
  | Term    of char
type rule = element list

(* and a grammar itself is a set---er, list, for us---that maps
 * nonterminal names to one or more rules. *)
type grammar = (string * rule) list

(* We'll work with the same grammar that's described in the paper:
 *   S' ::= S
 *   S  ::= ACa | BDd
 *   A  ::= AD | a
 *   B  ::= BC | b
 *   C  ::= c
 *   D  ::= d
 *)

let test_grammar =
  [ "S'", [ Nonterm "S" ]
  ; "S",  [ Nonterm "A"; Nonterm "C"; Term 'a' ]
  ; "S",  [ Nonterm "B"; Nonterm "D"; Term 'd' ]
  ; "A",  [ Nonterm "A"; Nonterm "D" ]
  ; "A",  [ Term 'a' ]
  ; "B",  [ Nonterm "B"; Nonterm "C" ]
  ; "B",  [ Term 'b' ]
  ; "C",  [ Term 'c' ]
  ; "D",  [ Term 'd' ]
  ]

(* Every action in our generated table is going to be either a
 * Shift, which will give us the new state as well, or a Resolve,
 * which will produce a non-terminal and optionally pop some
 * things from the stack.
 *)
type state = int
type action =
  | Shift of state
  | Resolve of element * int

(* This is not the best data structure to put a table in. *)
type table = (int * element) -> action option
let empty : table = fun _ -> None
let lookup (t : table) (k : int * element) = t k
let insert (k : int * element) (v : action) (t : table) =
  fun k' -> if k = k' then Some v else lookup t k'

let sample : table = (empty
  |> insert (0, Term 'a')     (Shift 4)
  |> insert (0, Term 'b')     (Shift 5)
  |> insert (0, Nonterm "S")  (Shift 1)
  |> insert (0, Nonterm "A")  (Shift 2)
  |> insert (0, Nonterm "B")  (Shift 3)
  |> insert (1, Term '$')     (Resolve (Nonterm "S'", 0))
  |> insert (2, Term 'c')     (Shift 8)
  |> insert (2, Nonterm "C")  (Shift 6)
  |> insert (2, Nonterm "D")  (Shift 7)
  |> insert (3, Term 'c')     (Shift 8)
  |> insert (3, Nonterm "C")  (Shift 9)
  |> insert (3, Nonterm "D")  (Shift 10)
  |> insert (4, Term 'c')     (Shift 8)
  |> insert (4, Nonterm "C")  (Resolve (Nonterm "A", 0))
  |> insert (4, Nonterm "D")  (Resolve (Nonterm "A", 0))
  |> insert (5, Term 'c')     (Shift 8)
  |> insert (5, Nonterm "C")  (Resolve (Nonterm "B", 0))
  |> insert (5, Nonterm "D")  (Resolve (Nonterm "B", 0))
  |> insert (6, Term 'a')     (Shift 11)
  |> insert (6, Term 'c')     (Shift 8)
  |> insert (7, Term 'c')     (Shift 8)
  |> insert (7, Nonterm "C")  (Resolve (Nonterm "A", 0))
  |> insert (7, Nonterm "D")  (Resolve (Nonterm "A", 0))
  |> insert (8, Term 'a')     (Resolve (Nonterm "C", 0))
  |> insert (8, Term 'b')     (Resolve (Nonterm "D", 0))
  |> insert (8, Term 'c')     (Shift 8)
  |> insert (8, Nonterm "C")  (Shift 12)
  |> insert (8, Nonterm "D")  (Shift 13)
  |> insert (9, Term 'c')     (Shift 8)
  |> insert (9, Nonterm "C")  (Resolve (Nonterm "B", 0))
  |> insert (9, Nonterm "D")  (Resolve (Nonterm "B", 0))
  |> insert (10, Term 'b')    (Shift 14)
  |> insert (10, Term 'c')    (Shift 8)
  |> insert (11, Term '$')    (Resolve (Nonterm "S", 0))
  |> insert (12, Term 'a')    (Resolve (Nonterm "D", 1))
  |> insert (12, Term 'c')    (Shift 8)
  |> insert (12, Nonterm "C") (Resolve (Nonterm "C", 1))
  |> insert (12, Nonterm "D") (Resolve (Nonterm "C", 1))
  |> insert (13, Term 'b')    (Resolve (Nonterm "C", 1))
  |> insert (13, Term 'c')    (Shift 8)
  |> insert (13, Nonterm "C") (Resolve (Nonterm "D", 1))
  |> insert (13, Nonterm "D") (Resolve (Nonterm "D", 1))
  |> insert (14, Term '$')    (Resolve (Nonterm "S", 0)))

let rec take n ls =
  if n = 0 then [] else (List.hd ls :: take (n-1) (List.tl ls))

let rec drop n ls =
  if n = 0 then ls else drop (n-1) (List.tl ls)

let runParser (t : table) (inp : char list) =
  let rec helper (inS : element list) (stS : state list) (st : state) =
    match inS with
      | [] -> stS
      | (i::is) -> match lookup t (st, i) with
                     | None -> raise (Failure "Unable to find rule")
                     | Some (Shift n) ->
                         helper is (n::stS) n
                     | Some (Resolve (s, i)) -> raise (Failure "..")
  in helper (List.map (fun x -> Term x) inp) [] 0
