type 'a t =
  | Empty
  | Pure of 'a
  | Unfold :
    { init : 's
    ; run : 'r . 's -> ('s -> 'a -> 'r) -> 'r -> 'r } -> 'a t
  | Bind : 'e t * ('e -> 'a t) -> 'a t

let empty = Empty
let pure x = Pure x

let rec map : type a b . (a -> b) -> a t -> b t =
  fun f -> function
  | Empty -> Empty
  | Pure x -> Pure (f x)
  | Unfold u ->
    let run s y = u.run s (fun s x -> y s (f x)) in
    Unfold { u with run }
  | Bind (s, g) -> Bind (s, fun x -> map f (g x))
[@@inline always]

let rec filter p = function
  | Empty -> Empty
  | Pure x as y when p x -> y
  | Pure _ -> Empty
  | Unfold u ->
    let rec run s y n = u.run
      s
      (fun [@inline] s x -> if p x then y s x else run s y n)
      n in
    Unfold { u with run }
  | Bind (s, g) -> Bind (s, fun x -> filter p (g x))
[@@inline always]

let rec iter : type a . (a -> unit) -> a t -> unit =
  fun f -> function
  | Empty -> ()
  | Pure x -> f x
  | Unfold u ->
    let rec loop st =
      u.run st
        (fun s x -> f x; loop s)
        () in
    loop u.init
  | Bind (s, g) ->
    iter (fun x -> iter f (g x)) s

let sum s =
  let res = ref 0 in
  (iter [@inlined]) (fun x -> res := !res + x) s;
  !res
[@@inline always]

let enum low high =
  let run st on_val on_zero =
    if st > high then on_zero else on_val (st + 1) st in
  Unfold { init = low; run }
[@@inline always]

let rec bind : type a b . (a -> b t) -> a t -> b t =
  fun f -> function
  | Empty -> Empty
  | Pure x -> f x
  | Bind (s, g) -> Bind (s, fun x -> bind f (g x))
  | s -> Bind (s, f)

let (>>=) x f = bind f x

let high = 100_000_000

let res = enum 1 high
  |> filter (fun x -> x mod 2 = 0)
  |> map (( * ) 2)
  >>= pure
  |> map (fun x -> x)
  >>= pure
  |> map (fun x -> x)
  >>= pure
  |> filter (fun _ -> true)
  >>= pure
  |> map (fun x -> x)
  >>= pure
  >>= pure
  >>= pure
  |> map (fun x -> x)
  >>= pure
  |> map (fun x -> x)
  >>= pure
  |> filter (fun _ -> true)
  |> sum

let _ = Printf.printf "%d\n" res