Source

lambda-translator / parserUtil.ml

type ('l, 'r) either = Inl of 'l | Inr of 'r
type error_msg = string
type ('a, 'ts) parser = 'ts -> ('a * 'ts, error_msg) either

let (<|>) : ('a, 'ts) parser -> ('a, 'ts) parser -> ('a, 'ts) parser =
    fun p1 p2 ->
      fun code ->
	match p1 code, p2 code with
	| Inl (x1, ts), _ -> Inl (x1, ts)
	| _, Inl (x2, ts) -> Inl (x2, ts)
	| Inr (msg1), Inr (msg2) -> Inr (msg1 ^ " <|> " ^ msg2)
	      
let (>>=) : ('a, 'ts) parser -> ('a -> ('b, 'ts) parser) -> ('b, 'ts) parser = 
    fun p f ->
      fun code ->
	match p code with
	| Inl (x, ts) -> f x ts
	| Inr msg -> Inr msg

let (>>) : ('a, 'ts) parser -> ('b, 'ts) parser -> ('b, 'ts) parser =
    fun p1 p2 ->
      p1 >>= fun _ -> p2

let return : 'a -> ('a, 'ts) parser =
    fun x ->
      fun code -> Inl (x, code)

let many p =
  let rec local store code = match p code with
    | Inl (x, ts) -> local (x::store) ts
    | Inr _ -> List.rev store, code
  in
  fun code -> Inl (local [] code)

let opt p = fun code -> match p code with
  | Inl (x, ts) -> Inl (Some x, ts)
  | Inr _ ->  Inl (None, code)