iteratees.ml

type ('a,'r) iter =
  | Done of 'r
  | Cont of ('a option -> ('a,'r) iter)


let head = let k x = Done x in Cont k


let len () =
  let rec k acc x =
    match x with | Some _ ->
    Cont (k (1 + acc)) | None  -> Done acc in
  Cont (k 0)
  
let rec el xs i =
  match i with
  | Done r -> r
  | Cont k ->
  
      (match xs with
       | [] ->

         (match k None with
         | Done r -> r
         | _ -> failwith "protocol")
       | x::xs -> el xs (k (Some x)))
       
       
let () = Js.log (el [1; 2; 3] (len ()))

iteratees_explicit_s_1.ml

type ('a,'r) iter =
  | Done of 'r
  | Cont of ('a option -> 'r -> 'r * ('a,'r) iter)

type ('a,'r) ii =
  {s: 'r;i:('a,'r) iter}

let len () =
  let rec k x acc =
    match x with
    | Some _ ->
      acc +1, Cont k
    | None -> acc, Done acc in
  {s=0;i=Cont k}
  
let el xs ii =
  let rec go xs s i =
  match i with
  | Done r -> r
  | Cont k ->
    match xs with
    | [] ->
      (match k None s with
       | _, Done r -> r
       | _ -> failwith "protocol")
    | x::xs ->
      let s, i = k (Some x) s in
      go xs s i in
  go xs ii.s ii.i
       
       
let () = Js.log (el [1; 2; 3] (len ()))

iteratees_explicit_s_2.ml

type ('a,'r) iter =
  | Done of 'r
  | Cont of ('a option -> 'r -> 'r)

type ('a,'r) ii =
  {s: 'r;i:('a,'r) iter}

let len () =
  let k x acc =
    match x with
    | Some _ -> acc + 1
    | None -> acc in
  {s=0;i=Cont k}
  
let el xs ii =
  let rec go xs s =
  match ii.i with
  | Done r -> r
  | Cont k ->
    match xs with
    | [] -> k None s
    | x::xs ->
      let s = k (Some x) s in
      go xs s in
  go xs ii.s
       
       
let () = Js.log (el [1; 2; 3] (len ()))