Detach driver from omp

src/driver.mli

@@ -179,6 +179,6 @@ val run_as_ppx_rewriter : unit -> unit
 val pretty : unit -> bool
 
 (**/**)
-val map_structure : structure -> Migrate_parsetree.Driver.some_structure
+val map_structure : structure -> structure
 
 val enable_checks : unit -> unit

src/dune

@@ -5,7 +5,6 @@
   ocaml-compiler-libs.common
   compiler-libs.common
   ocaml-compiler-libs.shadow
-  ocaml-migrate-parsetree
   ppx.ast_deprecated
   ppx.bootstrap
   ppx.print_diff

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 ->
@@ -40,7 +40,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 with_loc_and_path f =
     fun ~ctxt -> f ~loc:ctxt.derived_item_loc ~path:(Code_path.to_string_path ctxt.base.code_path)

src/expansion_context.mli

@@ -9,7 +9,7 @@ module Base : sig
       ocaml-mirgate-parsetree configuration.
   *)
   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)
@@ -53,7 +55,7 @@ module Deriver : sig
   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
+  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)

src/utils.ml

@@ -26,40 +26,59 @@ module Kind = struct
   let equal : t -> t -> bool = (=)
 end
 
-module Some_intf_or_impl = struct
+module Ast_io = struct
   type t =
-    | Intf of Migrate_parsetree.Driver.some_signature
-    | Impl of Migrate_parsetree.Driver.some_structure
+    | Intf of Compiler_types.signature
+    | Impl of Compiler_types.structure
 
-  let to_ast_io (ast : t) ~add_ppx_context =
-    let open Migrate_parsetree in
-    match ast with
-    | Intf (Migrate_parsetree.Driver.Sig ((module Ver), sg)) ->
-      let sg =
-        (Migrate_parsetree.Versions.migrate
-           (module Ver)
-           (module Versions.OCaml_current)).copy_signature sg
-      in
-      let sg =
-        if add_ppx_context then
-          Ocaml_common.Ast_mapper.add_ppx_context_sig ~tool_name:"ppx_driver" sg
-        else
-          sg
-      in
-      Ast_io.Intf ((module Versions.OCaml_current), sg)
-    | Impl (Migrate_parsetree.Driver.Str ((module Ver), st)) ->
-      let st =
-        (Migrate_parsetree.Versions.migrate
-                      (module Ver)
-                      (module Versions.OCaml_current)).copy_structure st
-      in
-      let st =
-        if add_ppx_context then
-          Ocaml_common.Ast_mapper.add_ppx_context_str ~tool_name:"ppx_driver" st
-        else
-          st
-      in
-      Ast_io.Impl ((module Versions.OCaml_current), st)
+  type read_error =
+    | Not_a_binary_ast of string
+    (* The input doesn't contain a binary AST. The argument
+       corresponds to the bytes from the input that were consumed. *)
+  | Unknown_version of string
+    (* The input contains a binary AST for an unknown version of
+       OCaml.  The argument is the unknown magic number. *)
+
+  let magic_length = String.length Ocaml_common.Config.ast_impl_magic_number
+
+  let read_magic ic =
+    let buf = Bytes.create magic_length in
+    let len = input ic buf 0 magic_length in
+    let s = Bytes.sub_string buf ~pos:0 ~len in
+    if len = magic_length then
+      Ok s
+    else
+      Error s
+
+  let read ic =
+    match read_magic ic with
+    | Error s -> Error (Not_a_binary_ast s)
+    | Ok s ->
+      if s = Ocaml_common.Config.ast_impl_magic_number then
+        let filename : string = input_value ic in
+        let payload = Impl (input_value ic) in
+        Ok (filename, payload)
+      else if s = Ocaml_common.Config.ast_intf_magic_number then
+        let filename : string = input_value ic in
+        let payload = Intf (input_value ic) in
+        Ok (filename, payload)
+      else
+      if s = String.sub Ocaml_common.Config.ast_impl_magic_number ~pos:0 ~len:9 ||
+         s = String.sub Ocaml_common.Config.ast_intf_magic_number ~pos:0 ~len:9 then
+        Error (Unknown_version s)
+      else
+        Error (Not_a_binary_ast s)
+
+  let write oc (filename : string) x =
+    match x with
+    | Intf x ->
+      output_string oc Ocaml_common.Config.ast_intf_magic_number;
+      output_value oc filename;
+      output_value oc x
+    | Impl x ->
+      output_string oc Ocaml_common.Config.ast_impl_magic_number;
+      output_value oc filename;
+      output_value oc x
 end
 
 module Intf_or_impl = struct
@@ -83,38 +102,31 @@ module Intf_or_impl = struct
     | Intf _ -> Intf
     | Impl _ -> Impl
 
-  let of_some_intf_or_impl ast : t =
-    let open Some_intf_or_impl in
+  let of_ast_io ast : t =
     match ast with
-    | Intf (Migrate_parsetree.Driver.Sig ((module Ver), sg)) ->
-      Intf
-        (Conversion.ast_of_signature
-           ((Migrate_parsetree.Versions.migrate (module Ver)
-               (module Ppx_ast_deprecated.Selected_ast)).copy_signature sg))
-    | Impl (Migrate_parsetree.Driver.Str ((module Ver), st)) ->
-      Impl
-        (Conversion.ast_of_structure
-           ((Migrate_parsetree.Versions.migrate (module Ver)
-               (module Ppx_ast_deprecated.Selected_ast)).copy_structure st))
+    | Ast_io.Intf sg ->
+      Intf (Conversion.ast_of_signature sg)
+    | Ast_io.Impl st ->
+      Impl (Conversion.ast_of_structure st)
 
-  let of_ast_io ast : t =
-    let open Migrate_parsetree in
+  let to_ast_io (ast : t) ~add_ppx_context =
     match ast with
-    | Ast_io.Intf ((module Ver), sg) ->
-      let module C = Versions.Convert(Ver)(Ppx_ast_deprecated.Selected_ast) in
-      Intf (Conversion.ast_of_signature (C.copy_signature sg))
-    | Ast_io.Impl ((module Ver), st) ->
-      let module C = Versions.Convert(Ver)(Ppx_ast_deprecated.Selected_ast) in
-      Impl (Conversion.ast_of_structure (C.copy_structure st))
+    | Intf sg ->
+      let sg = Conversion.ast_to_signature sg in
+      let sg =
+        if add_ppx_context then
+          Ocaml_common.Ast_mapper.add_ppx_context_sig ~tool_name:"ppx_driver" sg
+        else
+          sg
+      in
+      Ast_io.Intf sg
+    | Impl st ->
+      let st = Conversion.ast_to_structure st in
+      let st =
+        if add_ppx_context then
+          Ocaml_common.Ast_mapper.add_ppx_context_str ~tool_name:"ppx_driver" st
+        else
+          st
+      in
+      Ast_io.Impl st
 end
-(*
-let map_impl x ~(f : _ Intf_or_impl.t -> _ Intf_or_impl.t) =
-  match f (Impl x) with
-  | Impl x -> x
-  | Intf _ -> assert false
-
-let map_intf x ~(f : _ Intf_or_impl.t -> _ Intf_or_impl.t) =
-  match f (Intf x) with
-  | Intf x -> x
-  | Impl _ -> assert false
-*)

test/driver/omp-integration/test/dune

@@ -1,4 +1,6 @@
 (test
  (name test)
  (flags (:standard -safe-string))
+ ;; TODO: re-enable once we make omp work with ppx
+ (enabled_if false)
  (preprocess (pps ppx_driver_omp_test_ppx ppx_ppx)))

test/expect/expect_test.mll

@@ -97,9 +97,7 @@ let apply_rewriters : (Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase) =
   | Ptop_dir _ as x -> x
   | Ptop_def s ->
     let s = Ppx.Conversion.ast_of_structure s in
-    Ptop_def (Ppx.Driver.map_structure s
-              |> Migrate_parsetree.Driver.migrate_some_structure
-                   (module Migrate_parsetree.OCaml_current))
+    Ptop_def (Ppx.Driver.map_structure s |> Ppx.Conversion.ast_to_structure)
 ;;
 let main () =
   run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf ->