Port to OMP

emillon · emillon · commit c660c72d1314 · 2018-01-17T19:16:16.000+01:00
This will make it possible to use newer versions of the OCaml compiler. Closes #22
diff --git a/4.02/compat.ml b/4.02/compat.ml
diff --git a/4.03/compat.ml b/4.03/compat.ml
diff --git a/4.04/compat.ml b/4.04/compat.ml
diff --git a/README.md b/README.md
@@ -73,13 +73,13 @@ How to configure ocamllint
 Similarly to how `ocamlbuild` works, it is necessary to write a plugin to modify
 the configuration. It is a dynamically-linked file from which one has to call
 `Ocamllint.Plugin.set_config`. The `example_plugin.ml` file is, well, an
-example. This plugin disables a warning. It can be built using `make example`.
+example. This plugin disables a warning.
 
 When the ppx rewriter is loaded without an argument, it will use a default
 configuration:
 
 ```
-% ocamlfind ppx_tools/rewriter -ppx "ocamlfind ocamllint/ppx_lint.native" -str
+% ocamlfind ppx_tools/rewriter -ppx "ocamlfind ocamllint/ppx_lint --as-ppx" -str
 'let y = []@[] in let x = 3 in x'
 File "", line 1, characters 17-31:
 (ocamllint) Useless let binding
@@ -91,8 +91,8 @@ let _ = let y = [] @ [] in let x = 3 in x
 If you pass an option to the rewriter, it will load the configuration:
 
 ```
-% ocamlfind ppx_tools/rewriter -ppx "ocamlfind ocamllint/ppx_lint.native
-_build/example_plugin.cmxs" -str 'let y = []@[] in let x = 3 in x'
+% ocamlfind ppx_tools/rewriter -ppx "ocamlfind ocamllint/ppx_lint --as-ppx
+--plugin _build/example_plugin.cmxs" -str 'let y = []@[] in let x = 3 in x'
 File "", line 1, characters 8-13:
 (ocamllint) List operation on litteral: @
 let _ = let y = [] @ [] in let x = 3 in x
diff --git a/_tags b/_tags
@@ -1,5 +1,7 @@
-true: package(compiler-libs.common)
-true: package(ppx_tools.metaquot)
+true: bin_annot
+true: package(ocaml-migrate-parsetree)
+true: package(ppx_tools_versioned.metaquot_404)
+true: package(ppx_tools_versioned)
 true: package(str)
 "lib": include
 <ppx/*>: package(dynlink)
diff --git a/lib/ast_tools.ml b/lib/ast_tools.ml
@@ -1,5 +1,5 @@
-open Asttypes
-open Parsetree
+open Migrate_parsetree.Ast_404.Asttypes
+open Migrate_parsetree.Ast_404.Parsetree
 
 let rec li_eq li1 li2 =
   let open Longident in
@@ -39,7 +39,7 @@ and expr_list_eq el1 el2 =
   with Invalid_argument _ -> false
 
 and label_eq l1 l2 =
-  let open Ast_convenience.Label in
+  let open Ppx_tools_404.Ast_convenience.Label in
   match explode l1, explode l2 with
   | Nolabel, Nolabel -> true
   | Labelled s1, Labelled s2
@@ -54,4 +54,18 @@ and expr_label_list_eq el1 el2 =
     List.for_all2 expr_label_eq el1 el2
   with Invalid_argument _ -> false
 
-let sigitem_attributes = Compat.sigitem_attributes
+let sigitem_attributes { psig_desc } =
+  match psig_desc with
+  | Psig_value vd -> [vd.pval_attributes]
+  | Psig_type (_, tdecls) -> List.map (fun tdecl -> tdecl.ptype_attributes) tdecls
+  | Psig_typext text -> [text.ptyext_attributes]
+  | Psig_exception exc -> [exc.pext_attributes]
+  | Psig_module md -> [md.pmd_attributes]
+  | Psig_recmodule mds -> List.map (fun md -> md.pmd_attributes) mds
+  | Psig_modtype pmtd -> [pmtd.pmtd_attributes]
+  | Psig_open popen -> [popen.popen_attributes]
+  | Psig_include pincl -> [pincl.pincl_attributes]
+  | Psig_class pcis
+  | Psig_class_type pcis -> List.map (fun pct -> pct.pci_attributes) pcis
+  | Psig_attribute attribute -> [[attribute]]
+  | Psig_extension (_, attributes) -> [attributes]
diff --git a/lib/ast_tools.mli b/lib/ast_tools.mli
@@ -1,7 +1,7 @@
-val expr_eq : Parsetree.expression -> Parsetree.expression -> bool
+val expr_eq : Migrate_parsetree.Ast_404.Parsetree.expression -> Migrate_parsetree.Ast_404.Parsetree.expression -> bool
 
 (**
    Return all attributes for a signature item.
    In some cases (e.g. recursive type declarations) there can be several ones.
  *)
-val sigitem_attributes : Parsetree.signature_item -> Parsetree.attributes list
+val sigitem_attributes : Migrate_parsetree.Ast_404.Parsetree.signature_item -> Migrate_parsetree.Ast_404.Parsetree.attributes list
diff --git a/lib/ocamllint_rules.ml b/lib/ocamllint_rules.ml
@@ -1,13 +1,13 @@
 open Ast_tools
-open Asttypes
-open Parsetree
+open Migrate_parsetree.Ast_404.Asttypes
+open Migrate_parsetree.Ast_404.Parsetree
 
 (** Allocated litterals *)
 let is_allocated_lit exp =
   match exp.pexp_desc with
   | Pexp_constant _ ->
     begin
-      match Ast_convenience.get_str exp with
+      match Ppx_tools_404.Ast_convenience.get_str exp with
       | Some _ -> true
       | None -> false
     end
@@ -229,7 +229,7 @@ let filter_rev_map : type a b . (a -> b option) -> a list -> b list
   go []
 
 let extract_ocaml_doc attributes =
-  let open Ast_convenience in
+  let open Ppx_tools_404.Ast_convenience in
   match find_attr_expr "ocaml.doc" attributes with
   | Some e -> get_str e
   | None -> None
diff --git a/lib/ocamllint_rules.mli b/lib/ocamllint_rules.mli
@@ -1,9 +1,9 @@
-val rate_expression : Parsetree.expression -> Ocamllint.Warning.t option
+val rate_expression : Migrate_parsetree.Ast_404.Parsetree.expression -> Ocamllint.Warning.t option
 
 val rate_module_name : string -> Ocamllint.Warning.t option
 
 val rate_module_type_name : string -> Ocamllint.Warning.t option
 
-val rate_signature_item : Parsetree.signature_item -> Ocamllint.Warning.t option
+val rate_signature_item : Migrate_parsetree.Ast_404.Parsetree.signature_item -> Ocamllint.Warning.t option
 
 val is_snake_case : string -> bool
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
diff --git a/pkg/META b/pkg/META
@@ -6,5 +6,5 @@ requires = "compiler-libs.common,ppx_tools.metaquot"
 package "ppx" (
     description = "Run ocamllint through a ppx"
     requires = "ocamllint"
-    ppx = "./ppx_lint"
+    ppx = "./ppx_lint --as-ppx"
 )
diff --git a/ppx/ppx_lint.ml b/ppx/ppx_lint.ml
@@ -1,6 +1,29 @@
-open Ast_mapper
-open Asttypes
-open Parsetree
+open Migrate_parsetree.Ast_404.Ast_mapper
+open Migrate_parsetree.Ast_404.Asttypes
+open Migrate_parsetree.Ast_404.Parsetree
+
+module Config : sig
+  val reset_args : unit -> unit
+
+  val args : (Arg.key * Arg.spec * Arg.doc) list
+
+  val plugin : unit -> string option
+end = struct
+  let plugin_ref = ref None
+
+  let set_plugin s =
+    plugin_ref := Some s
+
+  let plugin () =
+    !plugin_ref
+
+  let reset_args () =
+    plugin_ref := None
+
+  let args =
+    [ ("--plugin", Arg.String set_plugin, "Load plugin")
+    ]
+end
 
 let raise_errorf ?sub ?if_highlight ?loc message =
   message |> Printf.kprintf (fun str ->
@@ -12,8 +35,7 @@ let dynlink ?(loc=Location.none) filename =
   try
     Dynlink.loadfile filename
   with Dynlink.Error error ->
-    raise_errorf ~loc "Cannot load %s: %s" filename (Dynlink.error_message error)
-
+    raise_errorf ~loc "Cannot load %s: %s" filename (Dynlink.error_message error) 
 let load_config filename =
   dynlink filename;
   Ocamllint.Plugin.get_config ()
@@ -48,19 +70,18 @@ let handle_signature_item config sigitem =
   let loc = sigitem.psig_loc in
   warn_on config ~loc (Ocamllint_rules.rate_signature_item sigitem)
 
-let should_run () =
-  match tool_name () with
+let should_run {Migrate_parsetree.Driver.tool_name} =
+  match tool_name with
   | "ocamlc" -> true
   | "ocamlopt" -> true
   | _ -> false
 
-let lint_mapper argv =
-  let config = match argv with
-    | [] -> Ocamllint.Config.default
-    | [config_module] -> load_config config_module
-    | _ -> raise_errorf "Only one plugin can be loaded"
+let lint_mapper driver_config _ =
+  let config = match Config.plugin () with
+    | None -> Ocamllint.Config.default
+    | Some config_module -> load_config config_module
   in
-  if should_run () then
+  if should_run driver_config then
     { default_mapper with
       expr = (fun mapper expr ->
         handle config expr;
@@ -78,4 +99,13 @@ let lint_mapper argv =
   else
     default_mapper
 
-let () = register "lint" lint_mapper
+let main () =
+  Migrate_parsetree.Driver.register
+    ~name:"lint"
+    ~reset_args:Config.reset_args
+    ~args:Config.args
+    Migrate_parsetree.Versions.ocaml_404
+    lint_mapper;
+  Migrate_parsetree.Driver.run_main ()
+
+let () = main ()
diff --git a/test/tests.ml b/test/tests.ml
@@ -18,14 +18,20 @@ let warning_opt_to_string = function
   | None -> "(nothing)"
   | Some w -> Ocamllint.Warning.to_string w
 
+let string_of_expression expr =
+  let open Migrate_parsetree.Versions in
+  let migration = migrate ocaml_404 ocaml_current in
+  let current_expr = migration.copy_expression expr in
+  Pprintast.string_of_expression current_expr
+
 (** Test rate_expression. Note that the recursion is implemented by the
     ast_mapper, so subexpressions are not checked in this test.
 *)
 let test_expression =
   let open Ocamllint.Warning in
   let t (expr, r) =
     let name =
-      Printf.sprintf "Rate %s" (Pprintast.string_of_expression expr)
+      Printf.sprintf "Rate %s" (string_of_expression expr)
     in
     name >:: fun ctxt ->
       assert_equal
@@ -71,10 +77,13 @@ let test_expression =
     ]
 
 let string_of_signature_item x =
+  let open Migrate_parsetree.Versions in
   let open Format in
+  let migration = migrate ocaml_404 ocaml_current in
+  let current_sig = migration.copy_signature [x] in
   ignore (flush_str_formatter ()) ;
   let f = str_formatter in
-  Pprintast.signature f [x];
+  Pprintast.signature f current_sig;
   flush_str_formatter ()
 
 (**
@@ -93,9 +102,9 @@ let test_signature_item =
         r
         (Ocamllint_rules.rate_signature_item sigitem)
   in
-  let open Ast_helper in
-  let open Location in
-  let open Parsetree in
+  let open Migrate_parsetree.Ast_404.Ast_helper in
+  let open Migrate_parsetree.Ast_404.Location in
+  let open Migrate_parsetree.Ast_404.Parsetree in
   List.map t
     [ Sig.value @@ Val.mk
         ~attrs:
