hexpr_polymorphic.ml 1.71 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
open Hashcons

(* Although we cannot implement the method [visit_hash_consed] yet, as we need
   a hash-consing table to do that, we can announce what its type should be.
   The key subtlety here is that this method must be monomorphic in ['b].
   Indeed, we cannot hope to be able to build values of type ['b hash_consed]
   for every ['b]. We can only hope to build values of type ['b hash_consed]
   for a fixed (as yet undetermined) ['b], if we have a hash-consing table of
   type ['b Hashcons.t]. *)

class virtual ['self] hashcons_map_placeholder = object (_ : 'self)
  method virtual visit_hash_consed: 'env 'a .
    ('env -> 'a -> 'b) ->
    'env -> 'a hash_consed -> 'b hash_consed
end

(* This allows us to define the types [expr] and [hexpr]... *)

type 'expr oexpr =
  | EConst of int
  | EAdd of 'expr * 'expr

and hexpr =
  H of hexpr oexpr hash_consed [@@unboxed]

(* ... and generate a visitor class for them, where [visit_hash_consed]
   is a virtual method. So far, so good, it seems. *)

[@@deriving visitors { variety = "map"; name = "map_incomplete";
                       polymorphic = true;
                       ancestors = ["hashcons_map_placeholder"] }]

(* Assuming that a hash-consing table is given, we can then use this
   table in a concrete definition of [visit_hash_consed]. *)

(* The type ['b] is instantiated here with [hexpr oexpr]. We do not
   have a choice: this type is fixed by the definition of [hexpr].
   The generated method [visit_hexpr] contains a call to
   [visit_hash_consed] at this type. *)

class ['self] map (table : hexpr oexpr Hashcons.t) = object (_ : 'self)
  inherit [_] map_incomplete
  method visit_hash_consed visit_'a env { node = e; _ } =
    hashcons table (visit_'a env e)
end