Merge pull request #47 from ejgallego/ocaml+410

[ocaml] Support for OCaml 4.10

.travis.yml

@@ -16,6 +16,7 @@ env:
   - OCAML=4.08.0
   - OCAML=4.08.1
   - OCAML=4.09.0
+  - OCAML=4.10.0
 # Wait until ocaml-base-compiler.4.09.1 arrives to opam-repository
 #  - OCAML=4.09.1
 

CHANGES.md

@@ -1,3 +1,10 @@
+1.7.1
+-----
+
+  * Support for OCaml 4.10
+    #47
+    (Emilio J. Gallego Arias)
+
 1.7.0
 -----
 

ppx_import.opam

@@ -12,7 +12,7 @@ dev-repo: "git+https://github.com/ocaml-ppx/ppx_import.git"
 tags: [ "syntax" ]
 
 depends: [
-  "ocaml"                   {              >= "4.04.2" & < "4.10.0" }
+  "ocaml"                   {              >= "4.04.2" & < "4.11" }
   "dune"                    {              >= "1.2.0"  }
   "ppxlib"                  {              >= "0.3.1"  }
   "ppx_tools_versioned"     {              >= "5.2.2"  }

src/compat/env_lookup_ge_000.ml

@@ -0,0 +1,3 @@
+let lookup_module ~loc:_ lid env = Env.lookup_module ~load:true lid env
+let find_type env ~loc head_id = Typetexp.find_type env loc head_id
+let find_modtype env ~loc head_id = Typetexp.find_modtype env loc head_id

src/compat/env_lookup_ge_410.ml

@@ -0,0 +1,3 @@
+let lookup_module ~loc lid env = Env.lookup_module ~loc lid env |> fst
+let find_type env ~loc head_id = Env.lookup_type ~loc head_id env
+let find_modtype env ~loc:_ head_id = Env.find_modtype_by_name head_id env

src/compat/gen.ml

@@ -5,13 +5,29 @@ let include_ path =
   print_endline s;
   close_in ic
 
+let make_version ~version f_prefix =
+  let major, minor = version in
+  let file = Format.asprintf "%s_ge_%1d%02d.ml" f_prefix major minor in
+  Filename.concat "compat" file
+
+(* List of versions that need special treatment, check is greater or
+   equal than. Order is important! *)
+let include_table =
+  [ "types_module_type"    , [4,10; 4,8]
+  ; "types_signature_item" , [4,8]
+  ; "init_path"            , [4,9]
+  ; "env_lookup"           , [4,10]
+  ]
+
+let rec gen_compat real_version (f_prefix, version_list) =
+  match version_list with
+  | [] -> include_ (make_version ~version:(0,0) f_prefix)
+  | version :: vlist ->
+    if real_version >= version then
+      include_ (make_version ~version f_prefix)
+    else
+      gen_compat real_version (f_prefix, vlist)
+
 let () =
   let version = Scanf.sscanf Sys.ocaml_version "%d.%d" (fun a b -> (a, b)) in
-  if version >= (4, 8) then
-    include_ "compat/types_ge_408.ml"
-  else
-    include_ "compat/types_lt_408.ml";
-  if version >= (4, 9) then
-    include_ "compat/init_path_ge_409.ml"
-  else
-    include_ "compat/init_path_lt_409.ml"
+  List.iter (gen_compat version) include_table

src/compat/types_module_type_ge_000.ml

@@ -0,0 +1,4 @@
+type module_type_407 = Types.module_type
+
+let migrate_module_type : Types.module_type -> module_type_407 =
+  fun x -> x

src/compat/types_module_type_ge_408.ml

@@ -0,0 +1,11 @@
+type module_type_407 =
+  | Mty_ident of Path.t
+  | Mty_signature of Types.signature
+  | Mty_functor of Ident.t * Types.module_type option * Types.module_type
+  | Mty_alias of unit * Path.t
+
+let migrate_module_type : Types.module_type -> module_type_407 = function
+  | Mty_ident p -> Mty_ident p
+  | Mty_signature s -> Mty_signature s
+  | Mty_functor (i, mto, mt) -> Mty_functor (i, mto, mt)
+  | Mty_alias p -> Mty_alias ((), p)

src/compat/types_module_type_ge_410.ml

@@ -0,0 +1,16 @@
+type module_type_407 =
+  | Mty_ident of Path.t
+  | Mty_signature of Types.signature
+  | Mty_functor of Ident.t * Types.module_type option * Types.module_type
+  | Mty_alias of unit * Path.t
+
+let migrate_module_type : Types.module_type -> module_type_407 = function
+  | Mty_ident p -> Mty_ident p
+  | Mty_signature s -> Mty_signature s
+  | Mty_functor (fp, mt) ->
+    (match fp with
+     | Unit -> Mty_functor(Ident.create_local "_", None, mt)
+     | Named(i,mt) ->
+       let i = (match i with None -> Ident.create_local "_" | Some i -> i) in
+       Mty_functor (i, Some mt, mt))
+  | Mty_alias p -> Mty_alias ((), p)

src/compat/types_lt_408.ml → src/compat/types_signature_item_ge_000.ml

@@ -1,8 +1,3 @@
-type module_type_407 = Types.module_type
-
-let migrate_module_type : Types.module_type -> module_type_407 =
-  fun x -> x
-
 type signature_item_407 = Types.signature_item
 
 let migrate_signature_item : Types.signature_item -> signature_item_407 =

src/compat/types_ge_408.ml → src/compat/types_signature_item_ge_408.ml

@@ -1,15 +1,3 @@
-type module_type_407 =
-  | Mty_ident of Path.t
-  | Mty_signature of Types.signature
-  | Mty_functor of Ident.t * Types.module_type option * Types.module_type
-  | Mty_alias of unit * Path.t
-
-let migrate_module_type : Types.module_type -> module_type_407 = function
-  | Mty_ident p -> Mty_ident p
-  | Mty_signature s -> Mty_signature s
-  | Mty_functor (i, mto, mt) -> Mty_functor (i, mto, mt)
-  | Mty_alias p -> Mty_alias ((), p)
-
 type signature_item_407 =
   | Sig_value of Ident.t * Types.value_description
   | Sig_type of Ident.t * Types.type_declaration * Types.rec_status

src/ppx_import.ml

@@ -55,7 +55,7 @@ let string_of_lid lid =
     | Longident.Lapply (la, lb) -> print la ("(" :: print lb (")" :: acc))
   in String.concat "" (print lid [])
 
-let try_find_module ~loc:_ env lid =
+let try_find_module ~loc env lid =
   (* Note: we are careful to call `Env.lookup_module` and not
      `Typetexp.lookup_module`, because we want to reason precisely
      about the possible failures: we want to handle the case where
@@ -72,7 +72,7 @@ let try_find_module ~loc:_ env lid =
      but better be safe and bundle them in the same try..with.
   *)
   try
-    let path = Env.lookup_module ~load:true lid env in
+    let path = Compat.lookup_module ~loc lid env in
     let module_decl = Env.find_module path env in
     Some module_decl.md_type
   with Not_found -> None
@@ -362,7 +362,7 @@ let type_declaration ~tool_name mapper type_decl =
               (* In this case, we know for sure that the user intends this lident
                  as a type name, so we use Typetexp.find_type and let the failure
                  cases propagate to the user. *)
-              Typetexp.find_type env loc head_id |> snd
+              Compat.find_type env ~loc head_id |> snd
             | Ldot (parent_id, elem) ->
               let sig_items = locate_sig ~loc env parent_id in
               get_type_decl ~loc sig_items parent_id elem
@@ -449,7 +449,7 @@ let module_type ~tool_name mapper modtype_decl =
               (* In this case, we know for sure that the user intends this lident
                  as a module type name, so we use Typetexp.find_type and
                  let the failure cases propagate to the user. *)
-              Typetexp.find_modtype env loc head_id |> snd
+              Compat.find_modtype env ~loc head_id |> snd
             | Longident.Ldot (parent_id, elem) ->
               let sig_items = locate_sig ~loc env parent_id in
               get_modtype_decl ~loc sig_items parent_id elem

types_signature_item_ge_000.ml

@@ -0,0 +1 @@
+