eq, ord, show: also hygienically invoke functions from other modules.

Fixes #57.

Author: whitequark

src_plugins/ppx_deriving_eq.ml

@@ -84,7 +84,7 @@ and expr_of_typ quoter typ =
         [%expr fun (lazy x) (lazy y) -> [%e expr_of_typ typ] x y]
       | _, { ptyp_desc = Ptyp_constr ({ txt = lid }, args) } ->
         let equal_fn = Exp.ident (mknoloc (Ppx_deriving.mangle_lid (`Prefix "equal") lid)) in
-        let fwd = app equal_fn (List.map expr_of_typ args) in
+        let fwd = app (Ppx_deriving.quote quoter equal_fn) (List.map expr_of_typ args) in
         (* eta-expansion is necessary for recursive groups *)
         [%expr fun x -> [%e fwd] x]
       | _ -> assert false

src_plugins/ppx_deriving_ord.ml

@@ -90,7 +90,7 @@ and expr_of_typ quoter typ =
         [%expr fun (lazy x) (lazy y) -> [%e expr_of_typ typ] x y]
       | _, { ptyp_desc = Ptyp_constr ({ txt = lid }, args) } ->
         let compare_fn = Exp.ident (mknoloc (Ppx_deriving.mangle_lid (`Prefix "compare") lid)) in
-        let fwd = app compare_fn (List.map expr_of_typ args) in
+        let fwd = app (Ppx_deriving.quote quoter compare_fn) (List.map expr_of_typ args) in
         (* eta-expansion is necessary for recursive groups *)
         [%expr fun x -> [%e fwd] x]
       | _ -> assert false

src_plugins/ppx_deriving_show.ml

@@ -115,17 +115,15 @@ let rec expr_of_typ quoter typ =
           else Format.pp_print_string fmt "<not evaluated>"]
       | _, { ptyp_desc = Ptyp_constr ({ txt = lid }, args) } ->
         let args_pp = List.map (fun typ -> [%expr fun fmt -> [%e expr_of_typ typ]]) args in
-        begin match attr_polyprinter typ.ptyp_attributes with
-        | Some printer ->
-          let printer =
+        let printer =
+          match attr_polyprinter typ.ptyp_attributes with
+          | Some printer ->
             [%expr (let fprintf = Format.fprintf in [%e printer]) [@ocaml.warning "-26"]]
-          in
-          app (Ppx_deriving.quote quoter printer)
-              (args_pp @ [[%expr fmt]])
-        | None ->
-          app (Exp.ident (mknoloc (Ppx_deriving.mangle_lid (`Prefix "pp") lid)))
-              (args_pp @ [[%expr fmt]])
-        end
+          | None ->
+            Exp.ident (mknoloc (Ppx_deriving.mangle_lid (`Prefix "pp") lid))
+        in
+        app (Ppx_deriving.quote quoter printer)
+            (args_pp @ [[%expr fmt]])
       | _ -> assert false
       end
     | { ptyp_desc = Ptyp_tuple typs } ->

src_test/test_deriving_eq.ml

@@ -109,6 +109,13 @@ let test_poly_app ctxt =
   assert_equal ~printer true (equal_poly_app 1.0 1.0);
   assert_equal ~printer false (equal_poly_app 1.0 2.0)
 
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving eq]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving eq]
+
 let suite = "Test deriving(eq)" >::: [
     "test_simple"        >:: test_simple;
     "test_custom"        >:: test_custom;

src_test/test_deriving_ord.ml

@@ -123,6 +123,13 @@ let test_poly_app ctxt =
   assert_equal ~printer 0 (compare_poly_app 1.0 1.0);
   assert_equal ~printer (-1) (compare_poly_app 1.0 2.0)
 
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving ord]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving ord]
+
 module Warnings = struct
   module W4 = struct
     [@@@ocaml.warning "@4"]

src_test/test_deriving_show.ml

@@ -164,6 +164,13 @@ and 'a poly_abs = 'a
 let test_poly_app ctxt =
   assert_equal ~printer "1." (show_poly_app 1.0)
 
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving show]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving show]
+
 let suite = "Test deriving(show)" >::: [
     "test_alias"         >:: test_alias;
     "test_variant"       >:: test_variant;