parserMonad for pa_monad.ml

parserMonad.ml

(* ocamlc -pp 'camlp4orf pa_monad.cmo' parserMonad.ml *)

type ('a,'b) either = Left of 'a | Right of 'b

module Make
    (T : sig
      type ts
      type error
     end) : sig
      type ts = T.ts
      type error = T.error
      type 'a m = ts -> ('a * ts, error) either
      val return : 'a -> 'a m
      val bind   : 'a m -> ('a -> 'b m) -> 'b m
      val (<|>)  : 'a m -> 'a m -> 'a m
      val many : 'a m -> 'a list m
      val opt : 'a m -> 'a option m
    end =
  struct
    type ts = T.ts
    type error = T.error
    type 'a m = ts -> ('a * ts, error) either

    let return x = fun code -> Left (x, code)
    let bind p f = fun code ->
      match p code with
      | Left (x, ts) -> f x ts
      | Right err    -> Right err

    let (<|>) p1 p2 = fun code ->
      match p1 code, p2 code with
      | (Left _ as x) , _              -> x
      | _             , (Left _ as x)  -> x
      | Right _       , Right err      -> Right err

    let rec many p =
      perform
        x  <-- p;
        xs <-- many p;
        return (x::xs)
      <|> return []

    let opt p =
      perform
        x <-- p;
        return (Some x)
      <|> return None
  end