Merge pull request #149 from NathanReb/hide-omp-config

Don't leak OMP's config through ppxlib's API

src/driver.ml

@@ -134,7 +134,7 @@ module Transform = struct
       Some { first with loc_end = last.loc_end }
   ;;
 
-  let merge_into_generic_mappers t ~hook ~expect_mismatch_handler ~omp_config =
+  let merge_into_generic_mappers t ~hook ~expect_mismatch_handler ~tool_name =
     let { rules; enclose_impl; enclose_intf; impl; intf; _ } = t in
     let map =
       new Context_free.map_top_down rules
@@ -180,7 +180,7 @@ module Transform = struct
             gen_header_and_footer Structure_item whole_loc f
         in
         let file_path = File_path.get_default_path_str st in
-        let base_ctxt = Expansion_context.Base.top_level ~omp_config ~file_path in
+        let base_ctxt = Expansion_context.Base.top_level ~tool_name ~file_path in
         let attrs = map#structure base_ctxt attrs in
         let st = map#structure base_ctxt st in
         List.concat [ attrs; header; st; footer ]
@@ -204,7 +204,7 @@ module Transform = struct
             gen_header_and_footer Signature_item whole_loc f
         in
         let file_path = File_path.get_default_path_sig sg in
-        let base_ctxt = Expansion_context.Base.top_level ~omp_config ~file_path in
+        let base_ctxt = Expansion_context.Base.top_level ~tool_name ~file_path in
         let attrs = map#signature base_ctxt attrs in
         let sg = map#signature base_ctxt sg in
         List.concat [ attrs; header; sg; footer ]
@@ -313,7 +313,7 @@ let debug_dropped_attribute name ~old_dropped ~new_dropped =
   print_diff "reappeared"  old_dropped new_dropped
 ;;
 
-let get_whole_ast_passes ~hook ~expect_mismatch_handler ~omp_config =
+let get_whole_ast_passes ~hook ~expect_mismatch_handler ~tool_name =
   let cts =
     match !apply_list with
     | None -> List.rev !Transform.all
@@ -332,7 +332,7 @@ let get_whole_ast_passes ~hook ~expect_mismatch_handler ~omp_config =
   end;
   let cts =
     if !no_merge then
-      List.map cts ~f:(Transform.merge_into_generic_mappers ~hook ~omp_config
+      List.map cts ~f:(Transform.merge_into_generic_mappers ~hook ~tool_name
                          ~expect_mismatch_handler)
     else begin
       let get_enclosers ~f =
@@ -369,7 +369,7 @@ let get_whole_ast_passes ~hook ~expect_mismatch_handler ~omp_config =
         Transform.builtin_of_context_free_rewriters ~rules ~hook ~expect_mismatch_handler
           ~enclose_impl:(merge_encloser impl_enclosers)
           ~enclose_intf:(merge_encloser intf_enclosers)
-          ~omp_config
+          ~tool_name
         :: cts
     end
   in linters @ preprocess @ List.filter cts ~f:(fun (ct : Transform.t) ->
@@ -379,8 +379,8 @@ let get_whole_ast_passes ~hook ~expect_mismatch_handler ~omp_config =
 ;;
 
 let apply_transforms
-      ~omp_config ~field ~lint_field ~dropped_so_far ~hook ~expect_mismatch_handler x =
-  let cts = get_whole_ast_passes ~omp_config ~hook ~expect_mismatch_handler in
+      ~tool_name ~field ~lint_field ~dropped_so_far ~hook ~expect_mismatch_handler x =
+  let cts = get_whole_ast_passes ~tool_name ~hook ~expect_mismatch_handler in
   let x, _dropped, lint_errors =
   List.fold_left cts ~init:(x, [], [])
     ~f:(fun (x, dropped, lint_errors) (ct : Transform.t) ->
@@ -455,10 +455,10 @@ let as_ppx_config () =
     ?for_package:!Ocaml_common.Clflags.for_package
 
 let print_passes () =
+  let tool_name = "ppxlib_driver" in
   let hook = Context_free.Generated_code_hook.nop in
   let expect_mismatch_handler = Context_free.Expect_mismatch_handler.nop in
-  let omp_config = config ~hook ~expect_mismatch_handler in
-  let cts = get_whole_ast_passes ~hook ~expect_mismatch_handler ~omp_config in
+  let cts = get_whole_ast_passes ~hook ~expect_mismatch_handler ~tool_name in
   if !perform_checks then
     printf "<builtin:freshen-and-collect-attributes>\n";
   List.iter cts ~f:(fun ct -> printf "%s\n" ct.Transform.name);
@@ -480,7 +480,7 @@ let real_map_structure config cookies st =
   end;
   let st, lint_errors =
     apply_transforms st
-      ~omp_config:config
+      ~tool_name:config.Migrate_parsetree.Driver.tool_name
       ~field:(fun (ct : Transform.t) -> ct.impl)
       ~lint_field:(fun (ct : Transform.t) -> ct.lint_impl)
       ~dropped_so_far:Attribute.dropped_so_far_structure ~hook ~expect_mismatch_handler
@@ -528,7 +528,7 @@ let real_map_signature config cookies sg =
   end;
   let sg, lint_errors =
     apply_transforms sg
-      ~omp_config:config
+      ~tool_name:config.Migrate_parsetree.Driver.tool_name
       ~field:(fun (ct : Transform.t) -> ct.intf)
       ~lint_field:(fun (ct : Transform.t) -> ct.lint_intf)
       ~dropped_so_far:Attribute.dropped_so_far_signature ~hook ~expect_mismatch_handler

src/expansion_context.ml

@@ -1,12 +1,12 @@
 module Base = struct
   type t =
-    { omp_config : Migrate_parsetree.Driver.config
+    { tool_name : string
     ; code_path : Code_path.t
     }
 
-  let top_level ~omp_config ~file_path =
+  let top_level ~tool_name ~file_path =
     let code_path = Code_path.top_level ~file_path in
-    {omp_config; code_path}
+    {tool_name; code_path}
 
   let enter_expr t = {t with code_path = Code_path.enter_expr t.code_path}
   let enter_module ~loc name t = {t with code_path = Code_path.enter_module ~loc name t.code_path}
@@ -23,7 +23,7 @@ module Extension = struct
 
   let extension_point_loc t = t.extension_point_loc
   let code_path t = t.base.code_path
-  let omp_config t = t.base.omp_config
+  let tool_name t = t.base.tool_name
 
   let with_loc_and_path f =
     fun ~ctxt ->
@@ -41,7 +41,7 @@ module Deriver = struct
 
   let derived_item_loc t = t.derived_item_loc
   let code_path t = t.base.code_path
-  let omp_config t = t.base.omp_config
+  let tool_name t = t.base.tool_name
   let inline t = t.inline
 
   let with_loc_and_path f =

src/expansion_context.mli

@@ -6,10 +6,10 @@ module Base : sig
   (** Undocumented section *)
 
   (** Build a new base context at the top level of the given file with the given
-      ocaml-mirgate-parsetree configuration.
+      calling tool name.
   *)
   val top_level :
-    omp_config:Migrate_parsetree.Driver.config ->
+    tool_name:string ->
     file_path:string ->
     t
 
@@ -29,8 +29,10 @@ module Extension : sig
   (** Return the code path for the given context *)
   val code_path : t -> Code_path.t
 
-  (** Return the ocaml-migrate-parsetree configuration for the given expansion context *)
-  val omp_config : t -> Migrate_parsetree.Driver.config
+  (** Can be used within a ppx preprocessor to know which tool is
+      calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
+      ["ocaml"], ... . *)
+  val tool_name : t -> string
 
   (** Wrap a [fun ~loc ~path] into a [fun ~ctxt] *)
   val with_loc_and_path : (loc:Location.t -> path:string -> 'a) -> (ctxt:t -> 'a)
@@ -52,8 +54,10 @@ module Deriver : sig
   (** Return the code path for the given context *)
   val code_path : t -> Code_path.t
 
-  (** Return the ocaml-migrate-parsetree configuration for the given expansion context *)
-  val omp_config : t -> Migrate_parsetree.Driver.config
+  (** Can be used within a ppx preprocessor to know which tool is
+      calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"],
+      ["ocaml"], ... . *)
+  val tool_name : t -> string
 
   (** Wrap a [fun ~loc ~path] into a [fun ~ctxt] *)
   val with_loc_and_path : (loc:Location.t -> path:string -> 'a) -> (ctxt:t -> 'a)