hell.ml

(** Some aliases for readibility *)
type opt = Options.copts

type 'a gen = 'a Gen.t
type 'a fix = [ `Ok | `Gen of 'a gen ]

type ('a, 'b) op = {
  name : string;
  f : 'a -> 'b;
}

(** Type for pipelines, i.e a series of transformations to
    apply to the input. An ('a, 'b) t is a pipeline that
    takes an input of type ['a] and returns a value of type
    ['b]. *)
type (_, _) t =
  (** The end of the pipeline, the identity/reflexive constructor *)
  | End :
      ('a, 'a) t
  (** Apply a single function and then proceed with the rest of the pipeline *)
  | Map :
      ('a, 'c) op * ('c, 'b) t -> ('a, 'b) t
  (** Concat two pipeline. Not tail recursive. *)
  | Concat :
      ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
  (** Fixpoint expansion *)
  | Fix :
      ('opt * 'a, 'opt * 'a fix) op * ('opt * 'a, 'opt) t -> ('opt * 'a, 'opt) t
  (** Fold a pipeline over a pipeline that returns a generator. *)
  | Fold :
      ('opt * 'a, 'opt) t -> ('opt * 'a gen, 'opt) t

(** Creating pipelines. *)

let op ?(name="") f = { name; f; }
let po ?(name="") f =
  { name; f = (fun ((opt, y) as x) -> opt, f x); }

let _end = End
let (~~~) x = x
let (@++) op t = Map(op, t)
let (@**) op t = Fix(op, t)
let (@<<) op t = Map(op, Fold t)
let (@>>) t t' = Concat (t, t')
let (@||) op t = Map({ op with f = (fun x -> op.f x; x) }, t)