upgrade ppx to OCaml 4.11 ast (#123)

ppx-driver/gen_js_api_ppx_driver.ml

@@ -1,4 +1,4 @@
-module From_ppx = Migrate_parsetree.Versions.OCaml_408
+module From_ppx = Migrate_parsetree.Versions.OCaml_411
 module Selected =  Ppxlib.Select_ast(From_ppx)
 
 module Of_ppxlib = struct
@@ -15,15 +15,15 @@ module To_ppxlib = struct
   let copy_module_expr (m : From_ppx.Ast.Parsetree.module_expr) : Ppxlib.Parsetree.module_expr =
     match
       copy_structure
-        [ From_ppx.Ast.Ast_helper.(Str.module_ (Mb.mk ({txt= "FAKE";loc=Location.none}) m))]
+        [ From_ppx.Ast.Ast_helper.(Str.module_ (Mb.mk ({txt= Some "FAKE";loc=Location.none}) m))]
     with
     | [{pstr_desc=Pstr_module {pmb_expr;_}; _}] -> pmb_expr
     | _ -> assert false
 
   let copy_attribute (a : From_ppx.Ast.Parsetree.attribute)
   : Ppxlib.Ast.attribute =
-  let pat : Migrate_parsetree.Ast_408.Parsetree.pattern =
-    Migrate_parsetree.Ast_408.Ast_helper.Pat.any ~attrs:[a] ()
+  let pat : Migrate_parsetree.Ast_411.Parsetree.pattern =
+    Migrate_parsetree.Ast_411.Ast_helper.Pat.any ~attrs:[a] ()
   in
   let pat = copy_pattern pat in
   List.hd pat.ppat_attributes

ppx-lib/gen_js_api_ppx.ml

@@ -2,7 +2,7 @@
 (* See the attached LICENSE file.                                         *)
 (* Copyright 2015 by LexiFi.                                              *)
 
-open Migrate_parsetree.Ast_408
+open Migrate_parsetree.Ast_411
 
 open Location
 open Asttypes
@@ -94,7 +94,7 @@ let str_of_payload loc = function
   | _ -> error loc Structure_expected
 
 let id_of_expr = function
-  | {pexp_desc=Pexp_constant (Pconst_string (s, _)); _} -> s
+  | {pexp_desc=Pexp_constant (Pconst_string (s, _, _)); _} -> s
   | e -> error e.pexp_loc Identifier_expected
 
 let get_expr_attribute key attrs =
@@ -199,7 +199,7 @@ let get_js_constr ~global_attrs name attributes =
   | None -> `String (js_name ~global_attrs name)
   | Some (k, v) ->
       begin match (expr_of_payload k.loc v).pexp_desc with
-      | Pexp_constant (Pconst_string (s, _)) -> `String s
+      | Pexp_constant (Pconst_string (s, _, _)) -> `String s
       | Pexp_constant (Pconst_integer (n, _)) -> `Int (int_of_string n)
       | _ -> error k.loc Invalid_expression
       end
@@ -482,12 +482,12 @@ let rec parse_sig_item ~global_attrs rest s =
       parse_valdecl ~global_attrs ~in_sig:true vd :: rest ~global_attrs
   | Psig_type (rec_flag, decls) ->
       Type (rec_flag, decls, global_attrs) :: rest ~global_attrs
-  | Psig_module {pmd_name; pmd_type = {pmty_desc = Pmty_signature si; pmty_attributes; pmty_loc = _}; pmd_loc = _; pmd_attributes} ->
+  | Psig_module {pmd_name = { txt = Some name; _}; pmd_type = {pmty_desc = Pmty_signature si; pmty_attributes; pmty_loc = _}; pmd_loc = _; pmd_attributes} ->
       (let global_attrs =
-         push_module_attributes pmd_name.txt pmty_attributes
-           (push_module_attributes pmd_name.txt pmd_attributes global_attrs)
+         push_module_attributes name pmty_attributes
+           (push_module_attributes name pmd_attributes global_attrs)
        in
-       Module (pmd_name.txt, parse_sig ~global_attrs si)) :: rest ~global_attrs
+       Module (name, parse_sig ~global_attrs si)) :: rest ~global_attrs
   | Psig_class cs -> Class (List.map (parse_class_decl ~global_attrs) cs) :: rest ~global_attrs
   | Psig_attribute ({attr_payload = PStr str; _} as attribute) when filter_attr_name "js.implem" attribute -> Implem str :: rest ~global_attrs
   | Psig_attribute attribute ->
@@ -500,7 +500,7 @@ let rec parse_sig_item ~global_attrs rest s =
 and push_module_attributes module_name module_attributes global_attrs =
   let rec rev_append acc = function
     | ({attr_name = {txt = "js.scope"; _}; attr_payload = PStr [];  _}) as attribute :: tl ->
-        rev_append ({ attribute with attr_payload = PStr [Str.eval (Exp.constant (Pconst_string (module_name, None)))] } :: acc) tl
+        rev_append ({ attribute with attr_payload = PStr [Str.eval (Exp.constant (Pconst_string (module_name, Location.none, None)))] } :: acc) tl
     |  hd :: tl -> rev_append (hd :: acc) tl
     | [] -> acc
   in
@@ -583,11 +583,13 @@ and parse_class_field ~global_attrs = function
 
 (** Code generation *)
 
-let var x = Exp.ident (mknoloc (Longident.parse x))
-let str s = Exp.constant (Pconst_string (s, None))
+let longident_parse x = Longident.parse x [@@ocaml.warning "-deprecated"]
+
+let var x = Exp.ident (mknoloc (longident_parse x))
+let str s = Exp.constant (Pconst_string (s, Location.none, None))
 let int n = Exp.constant (Pconst_integer (string_of_int n, None))
 let pat_int n = Pat.constant (Pconst_integer (string_of_int n, None))
-let pat_str s = Pat.constant (Pconst_string (s, None))
+let pat_str s = Pat.constant (Pconst_string (s, Location.none, None))
 
 let attr s e = (Attr.mk (mknoloc s) (PStr [Str.eval e]))
 
@@ -604,7 +606,7 @@ let incl = function
 
 let nolabel args = List.map (function x -> Nolabel, x) args
 
-let ojs_typ = Typ.constr (mknoloc (Longident.parse "Ojs.t")) []
+let ojs_typ = Typ.constr (mknoloc (longident_parse "Ojs.t")) []
 
 let ojs_var s = Exp.ident (mknoloc (Ldot (Lident "Ojs", s)))
 
@@ -613,7 +615,7 @@ let ojs s args = Exp.apply (ojs_var s) (nolabel args)
 let ojs_null = ojs_var "null"
 
 let list_iter f x =
-  Exp.apply (Exp.ident (mknoloc (Longident.parse "List.iter"))) (nolabel [f; x])
+  Exp.apply (Exp.ident (mknoloc (longident_parse "List.iter"))) (nolabel [f; x])
 
 let fun_ (label, s) e =
   match e.pexp_desc with
@@ -650,10 +652,10 @@ let unit_expr = Exp.construct unit_lid None
 let unit_pat = Pat.construct unit_lid None
 
 let some_pat arg =
-  Pat.construct (mknoloc (Longident.parse "Some")) (Some arg)
+  Pat.construct (mknoloc (longident_parse "Some")) (Some arg)
 
 let none_pat () =
-  Pat.construct (mknoloc (Longident.parse "None")) None
+  Pat.construct (mknoloc (longident_parse "None")) None
 
 let match_some_none ~some ~none exp =
   let s = fresh () in
@@ -733,7 +735,7 @@ let ojs_new_obj_arr cl = function
   | `Simple arr -> ojs "new_obj" [cl; arr]
   | `Push arr -> ojs "new_obj_arr" [cl; arr]
 
-let assert_false = Exp.assert_ (Exp.construct (mknoloc (Longident.parse "false")) None)
+let assert_false = Exp.assert_ (Exp.construct (mknoloc (longident_parse "false")) None)
 
 let rewrite_typ_decl t =
   let t = {t with ptype_private = Public} in
@@ -769,7 +771,7 @@ let get_variant_kind loc attrs =
         | PStr [] -> `Union No_discriminator
         | _ ->
             begin match expr_of_payload k.loc v with
-            | {pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "on_field";_}; _}, [Nolabel, {pexp_desc = Pexp_constant (Pconst_string (s, _)); _}]); _} -> `Union (On_field s)
+            | {pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "on_field";_}; _}, [Nolabel, {pexp_desc = Pexp_constant (Pconst_string (s, _, _)); _}]); _} -> `Union (On_field s)
             | _ -> error k.loc Unknown_union_method
             end
         end
@@ -962,7 +964,7 @@ and ml2js ctx ty exp =
       let extra_arg =
         match label_variadic with
         | Arg | Lab _ -> extra_arg
-        | Opt _ -> Exp.construct (mknoloc (Longident.parse "Some")) (Some extra_arg)
+        | Opt _ -> Exp.construct (mknoloc (longident_parse "Some")) (Some extra_arg)
       in
       let concrete_args = concrete_args @ [arg_label label_variadic, extra_arg] in
       let res = app exp concrete_args unit_arg in
@@ -1178,7 +1180,7 @@ and js2ml_unit ctx ty_res res =
 
 and gen_typ = function
   | Name (s, tyl) ->
-      Typ.constr (mknoloc (Longident.parse s)) (List.map gen_typ tyl)
+      Typ.constr (mknoloc (longident_parse s)) (List.map gen_typ tyl)
   | Js -> ojs_typ
   | Unit _ ->
       Typ.constr (mknoloc (Lident "unit")) []
@@ -1260,7 +1262,7 @@ let global_object ~global_attrs =
     | hd :: tl ->
         begin match get_expr_attribute "js.scope" [hd] with
         | None -> traverse tl
-        | Some {pexp_desc=Pexp_constant (Pconst_string (prop, _)); _} -> ojs "get" [(traverse tl); str prop]
+        | Some {pexp_desc=Pexp_constant (Pconst_string (prop, _, _)); _} -> ojs "get" [(traverse tl); str prop]
         | Some global_object -> global_object
         end
   in
@@ -1370,7 +1372,7 @@ and gen_decl = function
       [ Str.type_ rec_flag decls; Str.value rec_flag funs ]
 
   | Module (s, decls) ->
-      [ Str.module_ (Mb.mk (mknoloc s) (Mod.structure (gen_decls decls))) ]
+      [ Str.module_ (Mb.mk (mknoloc (Some s)) (Mod.structure (gen_decls decls))) ]
 
   | Val (_, _, Ignore, _, _) -> []
 
@@ -1416,7 +1418,7 @@ and gen_classdecl cast_funcs = function
         | Name (super_class, []) -> super_class
         | _ -> assert false
       in
-      let e = Cl.apply (Cl.constr (mknoloc (Longident.parse super_class)) []) [Nolabel, obj] in
+      let e = Cl.apply (Cl.constr (mknoloc (longident_parse super_class)) []) [Nolabel, obj] in
       let e = if unit_arg then Cl.fun_ Nolabel None unit_pat e else e in
       let f e (label, x) = Cl.fun_ label None (Pat.var (mknoloc x)) e in
       Ci.mk (mknoloc class_name) (List.fold_left f e (List.rev formal_args))
@@ -1443,7 +1445,7 @@ and gen_class_field x = function
 
 and gen_class_cast = function
   | Declaration { class_name; class_fields = _ } ->
-      let class_typ = Typ.constr (mknoloc (Longident.parse class_name)) [] in
+      let class_typ = Typ.constr (mknoloc (longident_parse class_name)) [] in
       let to_js =
         let arg = fresh() in
         Vb.mk (Pat.var (mknoloc (class_name ^ "_to_js")))
@@ -1684,11 +1686,11 @@ let usage = "gen_js_api [-o mymodule.ml] mymodule.mli"
 
 let from_current =
   let open Migrate_parsetree in
-  Versions.migrate Versions.ocaml_current Versions.ocaml_408
+  Versions.migrate Versions.ocaml_current Versions.ocaml_411
 
 let to_current =
   let open Migrate_parsetree in
-  Versions.migrate Versions.ocaml_408 Versions.ocaml_current
+  Versions.migrate Versions.ocaml_411 Versions.ocaml_current
 
 let standalone () =
   let files = ref [] in

ppx-lib/gen_js_api_ppx.mli

@@ -2,36 +2,36 @@
 (* See the attached LICENSE file.                                         *)
 (* Copyright 2015 by LexiFi.                                              *)
 
-val mark_as_handled_manually : (Migrate_parsetree.Ast_408.Parsetree.attribute -> unit) ref
+val mark_as_handled_manually : (Migrate_parsetree.Ast_411.Parsetree.attribute -> unit) ref
 
 val check_attribute : bool ref
 
-val mapper : Migrate_parsetree.Ast_408.Ast_mapper.mapper
+val mapper : Migrate_parsetree.Ast_411.Ast_mapper.mapper
 
 val module_expr_rewriter
   :  loc:Location.t
-  -> attrs:Migrate_parsetree.Ast_408.Parsetree.attributes
-  -> Migrate_parsetree.Ast_408.Parsetree.signature
-  -> Migrate_parsetree.Ast_408.Parsetree.module_expr
+  -> attrs:Migrate_parsetree.Ast_411.Parsetree.attributes
+  -> Migrate_parsetree.Ast_411.Parsetree.signature
+  -> Migrate_parsetree.Ast_411.Parsetree.module_expr
 
 val js_of_rewriter
   :  loc:Location.t
-  -> Migrate_parsetree.Ast_408.Parsetree.core_type
-  -> Migrate_parsetree.Ast_408.Parsetree.expression
+  -> Migrate_parsetree.Ast_411.Parsetree.core_type
+  -> Migrate_parsetree.Ast_411.Parsetree.expression
 
 val js_to_rewriter
   :  loc:Location.t
-  -> Migrate_parsetree.Ast_408.Parsetree.core_type
-  -> Migrate_parsetree.Ast_408.Parsetree.expression
+  -> Migrate_parsetree.Ast_411.Parsetree.core_type
+  -> Migrate_parsetree.Ast_411.Parsetree.expression
 
 val type_decl_rewriter
   :  loc:Location.t
-  -> Migrate_parsetree.Ast_408.Asttypes.rec_flag
-  -> Migrate_parsetree.Ast_408.Parsetree.type_declaration list
-  -> Migrate_parsetree.Ast_408.Parsetree.structure
+  -> Migrate_parsetree.Ast_411.Asttypes.rec_flag
+  -> Migrate_parsetree.Ast_411.Parsetree.type_declaration list
+  -> Migrate_parsetree.Ast_411.Parsetree.structure
 
 val mark_attributes_as_used
-  :  Migrate_parsetree.Ast_408.Ast_mapper.mapper
-  -> Migrate_parsetree.Ast_408.Ast_mapper.mapper
+  :  Migrate_parsetree.Ast_411.Ast_mapper.mapper
+  -> Migrate_parsetree.Ast_411.Ast_mapper.mapper
 
 val standalone : unit -> unit

ppx-standalone/gen_js_api.ml

@@ -2,7 +2,7 @@
 (* See the attached LICENSE file.                                         *)
 (* Copyright 2015 by LexiFi.                                              *)
 
-open Migrate_parsetree.Ast_408
+open Migrate_parsetree.Ast_411
 
 let () =
   try