Source file eq.ml

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
46
47
48
49
(** {i Eq} plugin: receive another value as inherited attribute and test for equality.

    Very similar to {!Compare} plugin.

    For type declaration [type ('a,'b,...) typ = ...] it will create a transformation
    function with type

    [('a -> 'a -> bool) ->
     ('b -> 'b -> bool) -> ... -> ('a,'b,...) typ -> bool ]

    Inherited attribute' is the same as argument, synthetized attribute is {!GT.comparison}.
*)

open GTCommon

let trait_name = "eq"

module Make(AstHelpers : GTHELPERS_sig.S) = struct

let trait_name = trait_name

module C = Compare.Make(AstHelpers)

open AstHelpers

class g initial_args tdecls = object(self: 'self)
  inherit C.g initial_args tdecls

  method! trait_name = trait_name

  method! syn_of_param ~loc s = Typ.sprintf ~loc "bool"
  method! syn_of_main ~loc ?in_class tdecl = self#syn_of_param ~loc "dummy"

  method! on_different_constructors ~loc is_poly other_name cname arg_typs =
    Exp.let_ ~loc [Pat.any ~loc, Exp.ident ~loc other_name]
      (Exp.false_ ~loc)
  method! chain_exprs ~loc e1 e2 =
    Exp.app_list ~loc (Exp.ident ~loc "&&") [ e1; e2 ]
  method! chain_init ~loc = Exp.true_ ~loc

end

let create = (new g :> C.P.plugin_constructor)
end

let register () =
  Expander.register_plugin trait_name (module Make: Plugin_intf.MAKE)

let () = register ()