G vs. E laziness

main.ml

(* The G method supports thunks well. *)
type 'a g_thunk_inner
  = GUnevaled of (unit -> 'a)
  | GEvaled of 'a

type 'a g_thunk
  = GThunk of ('a g_thunk_inner) ref

let g_force (th: 'a g_thunk): 'a =
  let GThunk th = th in
  match !th with
  | GUnevaled x ->
          let v = x () in
          th := GEvaled v;
          v
  | GEvaled x -> x

(* Yeah, in the E method, thunks are pretty shite. *)
type 'a e_thunk = EThunk of (unit -> 'a)

let e_force (th: 'a e_thunk): 'a =
  let EThunk f = th in
  f ()

(* G streams are harder to read though. *)
type 'a g_stream
  = GStream of ('a g_stream_inner) ref
and 'a g_stream_inner
  = GUnevaledStream of 'a * (unit -> 'a g_stream)
  | GEvaledStream of 'a * 'a g_stream

let g_head (s: 'a g_stream): 'a =
  let GStream s = s in
  match !s with
  | GUnevaledStream (h, _) -> h
  | GEvaledStream (h, _) -> h

let g_tail (s: 'a g_stream): 'a g_stream =
  let GStream s = s in
  match !s with
  | GUnevaledStream (h, f) ->
          let t = f () in
          s := GEvaledStream (h, t);
          t
  | GEvaledStream (_, t) -> t

let rec g_nth (n: int) (s: 'a g_stream): 'a =
  if n = 0 then
    g_head s
  else
    g_nth (n-1) (g_tail s)

(* E streams are much nicer. *)
type 'a e_stream = EStream of 'a * (unit -> 'a e_stream)

let e_head (s: 'a e_stream): 'a =
  let EStream (h, _) = s in
  h

let e_tail (s: 'a e_stream): 'a e_stream =
  let EStream (_, t) = s in
  t ()

let rec e_nth (n: int) (s: 'a e_stream): 'a =
  if n = 0 then
    e_head s
  else
    e_nth (n-1) (e_tail s)

(* Examples *)

let foo_inner () =
    print_endline "pretend this is some math that takes an hour";
    0

let g_foo = GThunk (ref (GUnevaled foo_inner))

let e_foo = EThunk foo_inner

let g_nats =
  let rec g_nats_from n =
    let f () =
      print_endline ("Taking tail of g_nats_from " ^ string_of_int n);
      g_nats_from (n+1)
    in GStream (ref (GUnevaledStream (n, f)))
  in g_nats_from 0

let e_nats =
  let rec e_nats_from n =
    let f () =
      print_endline ("Taking tail of e_nats_from " ^ string_of_int n);
      e_nats_from (n+1)
    in EStream (n, f)
  in e_nats_from 0

let test () =
  print_endline "Forcing g_foo twice.";
  print_endline (string_of_int (g_force g_foo));
  print_endline (string_of_int (g_force g_foo));
  print_endline "Forcing e_foo twice.";
  print_endline (string_of_int (e_force e_foo));
  print_endline (string_of_int (e_force e_foo));
  print_endline "Getting 5th of g_nats twice.";
  print_endline (string_of_int (g_nth 5 g_nats));
  print_endline (string_of_int (g_nth 5 g_nats));
  print_endline "Getting 5th of e_nats twice.";
  print_endline (string_of_int (e_nth 5 e_nats));
  print_endline (string_of_int (e_nth 5 e_nats));
  print_endline "=== DONE ==="