diff --git a/.github/workflows/build-and-test.yml b/.github/workflows/build-and-test.yml index 2197c7e..ac87a95 100644 --- a/.github/workflows/build-and-test.yml +++ b/.github/workflows/build-and-test.yml @@ -13,9 +13,6 @@ jobs: matrix: os: [ubuntu-latest] ocaml-compiler: - - 4.05.x - - 4.06.x - - 4.07.x - 4.08.x - 4.09.x - 4.10.x diff --git a/CHANGES.md b/CHANGES.md index 4a09d67..2620925 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,8 +1,13 @@ +1.12.0 +------ + + * Support for OCaml 5.4 (#100, @octachron, backport #104, @egallego) + * Support for OCaml 4.5, 4.6, and 4.7 has been removed (#104, @egallego) + 1.11.0 ------ - * Support for OCaml 5.2 (#94, @kit-ty-kate, backport to 1.x by - @ejgallego #97) + * Support for OCaml 5.2 (#94, @kit-ty-kate) 1.10.0 ------ diff --git a/ppx_import.opam b/ppx_import.opam index 9e9f653..690d65e 100644 --- a/ppx_import.opam +++ b/ppx_import.opam @@ -11,7 +11,7 @@ dev-repo: "git+https://github.com/ocaml-ppx/ppx_import.git" tags: [ "syntax" ] depends: [ - "ocaml" {>= "4.05.0" & < "4.10.0" } + "ocaml" {>= "4.08.0" & < "4.10.0" } | ("ocaml" {>= "4.10.0"} "ppx_sexp_conv" {with-test & >= "v0.13.0"}) "dune" { >= "1.11.0" } diff --git a/src/compat/gen.ml b/src/compat/gen.ml index 9a6c75a..30997bb 100644 --- a/src/compat/gen.ml +++ b/src/compat/gen.ml @@ -17,7 +17,10 @@ let include_table = ; ("types_type_kind", [(5, 2); (4, 13)]) ; ("init_path", [(4, 9)]) ; ("env_lookup", [(4, 10)]) - ; ("types_desc", [(4, 14)]) ] + ; ("types_desc", [(4, 14)]) + ; ("tuple", [5,4]) + ; ("longident", [5,4]) + ] let rec gen_compat real_version (f_prefix, version_list) = match version_list with diff --git a/src/compat/longident_ge_000.ml b/src/compat/longident_ge_000.ml new file mode 100644 index 0000000..09a8752 --- /dev/null +++ b/src/compat/longident_ge_000.ml @@ -0,0 +1,2 @@ +let longident_inj x = x +let longident_proj x = x diff --git a/src/compat/longident_ge_504.ml b/src/compat/longident_ge_504.ml new file mode 100644 index 0000000..2e82333 --- /dev/null +++ b/src/compat/longident_ge_504.ml @@ -0,0 +1,2 @@ +let longident_inj = Location.mknoloc +let longident_proj x = x.Location.txt diff --git a/src/compat/tuple_ge_000.ml b/src/compat/tuple_ge_000.ml new file mode 100644 index 0000000..1694863 --- /dev/null +++ b/src/compat/tuple_ge_000.ml @@ -0,0 +1,2 @@ +let tuple f xs = + Ppxlib.Ast_helper.Typ.tuple (List.map (fun x -> f x) xs) diff --git a/src/compat/tuple_ge_504.ml b/src/compat/tuple_ge_504.ml new file mode 100644 index 0000000..7b74c6a --- /dev/null +++ b/src/compat/tuple_ge_504.ml @@ -0,0 +1,2 @@ +let tuple f xs = + Ppxlib.Ast_helper.Typ.tuple (List.map (fun (_,x) -> f x) xs) diff --git a/src/ppx_import.ml b/src/ppx_import.ml index 3c4c828..e916412 100644 --- a/src/ppx_import.ml +++ b/src/ppx_import.ml @@ -27,14 +27,17 @@ let lazy_env = Compat.init_path (); Ocaml_common.Compmisc.initial_env () ) -let string_of_lid lid = - let rec print lid acc = - match lid with - | Longident.Lident s -> s :: acc - | Longident.Ldot (lid, id) -> print lid ("." :: id :: acc) - | Longident.Lapply (la, lb) -> print la ("(" :: print lb (")" :: acc)) - in - String.concat "" (print lid []) +let string_of_lid' lid = Format.asprintf "%a" Pprintast.longident lid +let string_of_lid lid = Format.asprintf "%a" Astlib.Pprintast.longident lid + +(* Remove locations *) +let rec longident_without_loc = + let proj x = Compat.longident_proj x in + let conv x = longident_without_loc (proj x) in + function + | Longident.Ldot (x,y) -> Astlib.Longident.Ldot (conv x, proj y) + | Longident.Lapply (f,x) -> Astlib.Longident.Lapply (conv f, conv x) + | Longident.Lident x -> Astlib.Longident.Lident x let try_find_module ~loc env lid = (* Note: we are careful to call `Env.lookup_module` and not @@ -68,7 +71,7 @@ let try_find_module_type ~loc env lid = | None -> Location.raise_errorf ~loc "[%%import]: cannot access the signature of the abstract module %s" - (string_of_lid lid) + (string_of_lid' lid) | Some module_type -> module_type ) with Not_found -> None @@ -93,12 +96,16 @@ let open_module_type ~loc env lid module_type = let locate_sig ~loc env lid = let head, path = match Ppxlib.Longident.flatten_exn lid with - | head :: path -> (Longident.Lident head, path) + | head :: path -> (head, path) | _ -> assert false + | exception Invalid_argument _ -> + Location.raise_errorf ~loc + "[%%import] cannot import a functor application %s" + (string_of_lid lid) in + let chead = Longident.Lident head in let head_module_type = - match - (try_find_module ~loc env head, lazy (try_find_module_type ~loc env head)) + match (try_find_module ~loc env chead, lazy (try_find_module_type ~loc env chead)) with | Some mty, _ -> mty | None, (lazy (Some mty)) -> mty @@ -124,10 +131,10 @@ let locate_sig ~loc env lid = let sub_module_type = loop (List.map Compat.migrate_signature_item sig_items) in - (Longident.Ldot (lid, path_item), sub_module_type) + (Astlib.Longident.Ldot(lid,path_item), sub_module_type) in let _lid, sub_module_type = - List.fold_left get_sub_module_type (head, head_module_type) path + List.fold_left get_sub_module_type (Astlib.Longident.Lident head, head_module_type) path in open_module_type ~loc env lid sub_module_type @@ -164,7 +171,7 @@ let get_modtype_decl ~loc sig_items parent_lid elem = elem (string_of_lid parent_lid) | Some decl -> decl -let longident_of_path = Untypeast.lident_of_path +let longident_of_path x = longident_without_loc (Untypeast.lident_of_path x) let mknoloc (txt : 'a) : 'a Ppxlib.Location.loc = {txt; loc = Ppxlib.Location.none} @@ -187,8 +194,7 @@ let rec core_type_of_type_expr ~subst (type_expr : Ocaml_common.Types.type_expr) | _ -> lhs in Ppxlib.Ast_helper.Typ.arrow label lhs (core_type_of_type_expr ~subst rhs) - | Ttuple xs -> - Ppxlib.Ast_helper.Typ.tuple (List.map (core_type_of_type_expr ~subst) xs) + | Ttuple xs -> Compat.tuple (core_type_of_type_expr ~subst) xs | Tconstr (path, args, _) -> ( let lid = longident_of_path path in let args = List.map (core_type_of_type_expr ~subst) args in @@ -387,11 +393,11 @@ let type_declaration ~tool_name ~input_name (type_decl : Ppxlib.type_declaration Location.raise_errorf ~loc "[%%import] cannot import a functor application %s" (string_of_lid lid) - | Lident _ as head_id -> + | Lident hid -> (* 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. *) - Compat.find_type env ~loc head_id |> snd + Compat.find_type env ~loc (Lident hid) |> snd | Ldot (parent_id, elem) -> let sig_items = locate_sig ~loc env parent_id in get_type_decl ~loc sig_items parent_id elem @@ -484,11 +490,11 @@ let module_type ~tool_name ~input_name (package_type : Ppxlib.package_type) = Location.raise_errorf ~loc "[%%import] cannot import a functor application %s" (string_of_lid lid) - | Longident.Lident _ as head_id -> + | Longident.Lident head_id -> (* 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. *) - Compat.find_modtype env ~loc head_id |> snd + Compat.find_modtype env ~loc (Lident 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 diff --git a/src_test/ppx_deriving/test_ppx_import.ml b/src_test/ppx_deriving/test_ppx_import.ml index c06de65..8772d4e 100644 --- a/src_test/ppx_deriving/test_ppx_import.ml +++ b/src_test/ppx_deriving/test_ppx_import.ml @@ -38,6 +38,12 @@ module Test_optional : S_optional = struct let f ?(opt = 0) () = ignore opt end +module Location = struct + type t = Location.t + let pp = Location.print_loc + type 'a loc = [%import: 'a Location.loc] [@@deriving show] +end + type longident = [%import: Longident.t] [@@deriving show] type package_type = @@ -47,7 +53,8 @@ type package_type = core_type := (Parsetree.core_type [@printer Pprintast.core_type]); Asttypes.loc := (Asttypes.loc [@polyprinter fun pp fmt x -> pp fmt x.Asttypes.txt]); - Longident.t := (Longident.t [@printer pp_longident])] )] + Longident.t := (Longident.t [@printer pp_longident]); + attributes := (Parsetree.attributes [@printer (fun _ _ -> ())])])] [@@deriving show] module type Hashable = [%import: (module Hashtbl.HashedType)]