source: Deliverables/D4.1/Parser.ml @ 130

open Util;;
open BitVectors;;
open ASM;;

type 'a parser = char list -> ('a * char list) list

let return x =
  fun y -> [(x, y)]

let (>>=) f g =
  fun x ->
    let frst = f x in
      List.concat $ List.map (fun (a, x') -> (g a) x') frst

let prs_zero = fun x -> []
;;

let prs_predicate p =
  function
    hd::tl ->
      if p hd then
        [(hd, tl)]
      else
        []
  | [] -> []
;;

let (++) f g =
  fun x ->
    f x @ g x
;;

let (+++) f g =
  fun x ->
    match (f ++ g) x with
      [] -> []
    | hd::tl -> [hd]
;;

let rec prs_many p =
    prs_many1 p +++ return []
and prs_many1 p =
         p           >>=
fun a -> prs_many p  >>=
fun b -> return $ a::b
;;

let rec prs_exact i p =
  if i = 0 then
    return []
  else
         p                   >>=
fun a -> prs_exact (i - 1) p >>=
fun b -> return $ a::b

let rec prs_sep_by p s =
  prs_sep_by1 p s +++ return []
and prs_sep_by1 p s =
         p                             >>=
fun a -> prs_many $ (s >>= fun _ -> p) >>=
fun b -> return $ a::b


let prs_char c = prs_predicate (fun x -> x = c)
;;

let prs_hex_digit =
  prs_predicate
    (fun x ->
       x = '0' || x = '1' || x = '2' || x = '3' ||
       x = '4' || x = '5' || x = '6' || x = '7' ||
       x = '8' || x = '9' || x = 'A' || x = 'B' ||
       x = 'C' || x = 'D' || x = 'E' || x = 'F')