existential.ml

(** Run:
      coretop existential.ml
*)

open Core.Std

type ('a, 'b) entity = {
  id        : unit -> string;
  step      : 'b -> 'b some_entity;
  to_string : unit -> string;
} and 'b some_entity =
  | Some_entity : ('a, 'b) entity -> 'b some_entity

let rec make_entity ~id ~step ~to_string ~state =
  let step x =
    let state = step state x in
    make_entity ~id ~to_string ~step ~state
  in
  let id () = id state in
  let to_string () = to_string state in
  Some_entity { id; to_string; step; }
;;

let make_sum_entity ~init =
  make_entity
    ~state:init
    ~id:(Fn.const "sum")
    ~to_string:Int.to_string
    ~step:(fun state i -> i + state)
;;

let make_cons_entity ~init =
  make_entity
    ~state:init
    ~id:(Fn.const "cons")
    ~to_string:(fun is ->
        (String.concat ~sep:", "
           (List.map ~f:Int.to_string is)))
    ~step:(fun state i -> i :: state)
;;

let print_entities entities =
  List.iteri entities ~f:(fun i (Some_entity entity) ->
      Printf.printf "#%d: %s\n" i (entity.to_string ()))
;;

let main () =
  let entities =
    [ make_sum_entity ~init:0
    ; make_cons_entity ~init:[]
    ]
  in
  print_entities entities;
  let (_ : _ some_entity list) =
    List.fold_left ~init:entities (List.init 3 ~f:Fn.id)
      ~f:(fun entities i ->
          let entities =
            List.map entities ~f:(fun (Some_entity entity) ->
                entity.step i)
          in
          print_entities entities;
          entities)
  in
  ()
;;

let () = main ();;