Skip to content

Instantly share code, notes, and snippets.

@gsg
Created July 24, 2015 09:00
Show Gist options
  • Save gsg/ec9fb6fdc3bd04ce3448 to your computer and use it in GitHub Desktop.
Save gsg/ec9fb6fdc3bd04ce3448 to your computer and use it in GitHub Desktop.
open Printf
module type T = sig type t end
module type ARGLIST = sig type 'a t end
module Nil = struct type 'a t = 'a end
module Arg (T : T) (Rest : ARGLIST) = struct
type 'a t = T.t -> 'a Rest.t
end
module type CON = sig
type s
module Args : ARGLIST
val name : string
val con : s Args.t
val decon : 'a Args.t -> 'a
end
module Type = struct
type _ t =
| Bool : bool t
| Int : int t
| Sum : string * ('s -> 's con) -> 's t
and 's con = (module CON with type s = 's)
end
type t =
| Foo
| Bar of int * bool
module IntT = struct type t = int end
module BoolT = struct type t = bool end
let rec print : type a . a Type.t -> a -> unit =
let open Type in
fun ty value ->
match ty with
| Bool -> printf "%b" value
| Int -> print_int value
| Sum (_, op) -> print_sum op value
and print_sum : type s . (s -> s Type.con) -> s -> unit =
let open Type in
fun op value ->
let module C : CON with type s = s = (val op value) in
print_string C.name;
(* trouble here *)
C.decon (assert false)
let rec copy : type a . a Type.t -> a -> a =
let open Type in
fun ty value ->
match ty with
| Bool -> value
| Int -> value
| Sum (_, op) -> copy_sum op value
and copy_sum : type s . (s -> s Type.con) -> s -> s =
let open Type in
fun op value ->
let module C : CON with type s = s = (val op value) in
C.decon C.con
let t_op : t -> t Type.con = function
| Foo ->
(module struct
type s = t
module Args = Nil
let name = "Foo"
let con = Foo
let decon x = x
end)
| Bar (i, b) ->
(module struct
type s = t
module Args = Arg (IntT) (Arg (BoolT) (Nil))
let name = "Bar"
let con i b = Bar (i, b)
let decon x = x i b
end)
let t_type = Type.(Sum ("t", t_op))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment