transducers in OCaml

transducers.ml

type 'a sequence =
    Nil
  | Cons of 'a * (unit -> 'a sequence)

type 'a reduced = Continue of 'a | Done of 'a

(* TODO: some transforms have no needs to be reduced, for example map and filter, GADT may help here *)
type ('acc, 'a) reducef = 'acc reduced -> 'a -> 'acc reduced
(** A reduce function (or reducer). *)

type ('acc, 'a, 'b) transducer = ('acc, 'a) reducef -> ('acc, 'b) reducef
(** A transducer convert a reducer to another reducer. *)

let compose f g =
  fun rf -> f (g rf)

let (>>) f g = compose f g

let extract_reduced = function
  | Continue result -> result
  | Done result -> result

(* Several transducers, map, filter, take, ... etc *)
let map f : ('acc, 'a, 'b) transducer =
  fun rf result el ->
  rf result (f el)

let filter pred : ('acc, 'a, 'b) transducer =
  fun rf result el ->
  if pred el then
    rf result el
  else
    result

let take n : ('acc, 'a, 'b) transducer =
  fun rf ->
  let state = (ref 0) in
  fun result el ->
    if !state = n then (
      Done (extract_reduced result)
    ) else (
      state := !state + 1;
      (rf result el)
    )

let rec reduce f acc = function
  | Nil -> extract_reduced acc
  | Cons (h, tl_thunk) ->
    let result = (f acc h) in
    match result with
    | Continue _ ->
      reduce f result (tl_thunk ())
    | Done result ->
      result

let transduce (xf : ('acc, 'a, 'b) transducer) rf init seq =
  let rf' acc el =
    let result = extract_reduced acc in
    Continue (rf result el) in
  reduce (xf rf') (Continue init) seq

let rec seq_list = function
  | [] -> Nil
  | x :: xs -> Cons (x, (fun () -> (seq_list xs)))

let rec seq_chan c =
  try
    let line = input_line c in
    Cons (line, (fun () -> (seq_chan c)))
  with End_of_file -> Nil

(*
let inc x = x + 1

let is_even x = x mod 2 = 0
let is_odd x = not (is_even x)

let _ =
  transduce (map inc >> filter is_odd) (+) 0 (seq_list [0;1;2;3;4;5;6;7;8;9])

let _ =
  transduce (take 5 >> map inc >> filter is_even) (+) 0 (seq_list [0;1;2;3;4;5;6;7;8;9])

*)