GADTs - avoiding type constructor escaping scope problems

Learning
,
1

I’m trying to write a module with this signature:

  type t

  type ('input, 'output) handler = ('output -> unit) -> 'input -> unit

  type ('input, 'output) key

  val create : unit -> t

  val add : ('input, 'output) handler -> t -> ('input, 'output) key

  val link : source:('a, 'b) key -> target:('b, 'c) key -> t -> t

  val send : ('input, _) key -> 'input -> t -> unit

(the idea is to define a load of handler functions and connect them up in arbitrary ways, where each one may trigger and be triggered by any number of others, including recursively)

I tried this

  type t = Hmap.t ref

  type ('input, 'output) handler = ('output -> unit) -> 'input -> unit

  type _ target_key = Key : ('input, 'output) key -> 'input target_key

  and ('input, 'output) key =
    (('input, 'output) handler * 'output target_key list) Hmap.key

  let create () = ref Hmap.empty

  let add (handler : ('input, 'ouput) handler) t =
    let key = Hmap.Key.create () in
    t := Hmap.add key (handler, []) !t;
    key

  let link ~(source : ('a, 'b) key) ~(target : ('b, 'c) key) t =
    let map = !t in
    let handler, previous_targets = Hmap.get source map in
    t := Hmap.add source (handler, Key target :: previous_targets) map;
    t

  let rec send (key : ('input, 'output) key) (value : 'input) t =
    let map = !t in
    let handler, targets = Hmap.get key map in
    let emitter event_from_source =
      List.iter targets ~f:(fun target ->
          match target with
          | Key target -> send (Caml.Obj.magic target) event_from_source t)
    in
    handler (Caml.Obj.magic emitter) value

which does work, but it would be better not to have the Obj.magics. Is there a way to avoid them? I can’t think of how to hide/expose the 'ouput of the targets in a good way.

1 Like
2

Your function send is polymorphically recursive, which means that you need an explicit type annotation:


 let rec send: type input output. (input, output) key -> input -> t -> unit =
  fun key value t ->
    let map = !t in
    let handler, targets = Hmap.get key map in
    let emitter event_from_source =
      List.iter (fun (Key target) ->  send target event_from_source t) targets
    in
    handler emitter value

After this small change, everything works as expected.

4 Likes
3

Thanks! I tried something like that but got the syntax wrong.