Skip to content

Instantly share code, notes, and snippets.

@scvalex

scvalex/existential.ml

Created May 3, 2014 15:03
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save scvalex/2e41e1c01e2266bbca5c to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save scvalex/2e41e1c01e2266bbca5c to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Alexandru Scvortov created this gist May 3, 2014.
    67 changes: 67 additions & 0 deletions existential.ml
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,67 @@
    (** 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 ();;