Skip to content

Commit

Permalink
feat: support OCaml 5.2
Browse files Browse the repository at this point in the history
  • Loading branch information
anmonteiro committed Feb 11, 2024
1 parent 56ceb6a commit f32f244
Show file tree
Hide file tree
Showing 21 changed files with 963 additions and 68 deletions.
9 changes: 8 additions & 1 deletion src/reason-parser-tests/testOprint.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,14 @@ let main () =
#else
let (typedtree, _) =
#endif
Typemod.type_implementation modulename modulename modulename env ast in
Typemod.type_implementation
#if OCAML_VERSION >= (5,2,0)
(Unit_info.make ~source_file:modulename modulename)
#else
modulename modulename modulename
#endif
env ast
in
let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in
let phrase = (Ast.Outcometree.Ophr_signature
(List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree)
Expand Down
2 changes: 2 additions & 0 deletions src/reason-parser/dune
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
(targets ocaml_util.ml)
(deps
../generate/select.exe
ocaml_util.ml-5.2
ocaml_util.ml-5.1
ocaml_util.ml-5.0
ocaml_util.ml-5.00
Expand All @@ -25,6 +26,7 @@
%{targets}
(run
../generate/select.exe
ocaml_util.ml-5.2
ocaml_util.ml-5.1
ocaml_util.ml-5.0
ocaml_util.ml-5.00
Expand Down
11 changes: 11 additions & 0 deletions src/reason-parser/ocaml_util.ml-5.2
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
let warn_latin1 lexbuf =
Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers"
;;

let print_loc ppf loc =
Location.print_loc ppf loc


let print_error loc f ppf x =
let error = Location.error_of_printer ~loc f x in
Location.print_report ppf error
24 changes: 0 additions & 24 deletions src/vendored-omp/src/ast_408_helper.ml

This file was deleted.

24 changes: 0 additions & 24 deletions src/vendored-omp/src/ast_409_helper.ml

This file was deleted.

Binary file added src/vendored-omp/src/ast_51.cmi
Binary file not shown.
Binary file added src/vendored-omp/src/ast_51.cmo
Binary file not shown.
Binary file added src/vendored-omp/src/ast_52.cmi
Binary file not shown.
Binary file added src/vendored-omp/src/ast_52.cmo
Binary file not shown.
201 changes: 201 additions & 0 deletions src/vendored-omp/src/ast_52.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,201 @@
module Asttypes = struct
type constant (*IF_CURRENT = Asttypes.constant *) =
Const_int of int
| Const_char of char
| Const_string of string * Location.t * string option
| Const_float of string
| Const_int32 of int32
| Const_int64 of int64
| Const_nativeint of nativeint

type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive

type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto

(* Order matters, used in polymorphic comparison *)
type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public

type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable

type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete

type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh

type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open

type label = string

type arg_label (*IF_CURRENT = Asttypes.arg_label *) =
Nolabel
| Labelled of string (** [label:T -> ...] *)
| Optional of string (** [?label:T -> ...] *)

type 'a loc = 'a Location.loc = {
txt : 'a;
loc : Location.t;
}

type variance (*IF_CURRENT = Asttypes.variance *) =
| Covariant
| Contravariant
| NoVariance

type injectivity (*IF_CURRENT = Asttypes.injectivity *) =
| Injective
| NoInjectivity
end

module Type_immediacy = struct
type t (*IF_CURRENT = Type_immediacy.t *) =
| Unknown
| Always
| Always_on_64bits
end

module Outcometree = struct
(* Module [Outcometree]: results displayed by the toplevel *)

(* These types represent messages that the toplevel displays as normal
results or errors. The real displaying is customisable using the hooks:
[Toploop.print_out_value]
[Toploop.print_out_type]
[Toploop.print_out_sig_item]
[Toploop.print_out_phrase] *)

(** An [out_name] is a string representation of an identifier which can be
rewritten on the fly to avoid name collisions *)
type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string }

type out_ident (*IF_CURRENT = Outcometree.out_ident *) =
| Oide_apply of out_ident * out_ident
| Oide_dot of out_ident * string
| Oide_ident of out_name

type out_string (*IF_CURRENT = Outcometree.out_string *) =
| Ostr_string
| Ostr_bytes

type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) =
{ oattr_name: string }

type out_value (*IF_CURRENT = Outcometree.out_value *) =
| Oval_array of out_value list
| Oval_char of char
| Oval_constr of out_ident * out_value list
| Oval_ellipsis
| Oval_float of float
| Oval_int of int
| Oval_int32 of int32
| Oval_int64 of int64
| Oval_nativeint of nativeint
| Oval_list of out_value list
| Oval_printer of (Format.formatter -> unit)
| Oval_record of (out_ident * out_value) list
| Oval_string of string * int * out_string (* string, size-to-print, kind *)
| Oval_stuff of string
| Oval_tuple of out_value list
| Oval_variant of string * out_value option
| Oval_lazy of out_value

type out_type_param (*IF_CURRENT = Outcometree.out_type_param *) = {
ot_non_gen: bool;
ot_name: string;
ot_variance: Asttypes.variance * Asttypes.injectivity
}

type out_type (*IF_CURRENT = Outcometree.out_type *) =
| Otyp_abstract
| Otyp_open
| Otyp_alias of {non_gen:bool; aliased:out_type; alias:string}
| Otyp_arrow of Asttypes.arg_label * out_type * out_type
| Otyp_class of out_ident * out_type list
| Otyp_constr of out_ident * out_type list
| Otyp_manifest of out_type * out_type
| Otyp_object of { fields: (string * out_type) list; open_row:bool}
| Otyp_record of (string * bool * out_type) list
| Otyp_stuff of string
| Otyp_sum of out_constructor list
| Otyp_tuple of out_type list
| Otyp_var of bool * string
| Otyp_variant of out_variant * bool * (string list) option
| Otyp_poly of string list * out_type
| Otyp_module of out_ident * (string * out_type) list
| Otyp_attribute of out_type * out_attribute

and out_constructor (*IF_CURRENT = Outcometree.out_constructor *) = {
ocstr_name: string;
ocstr_args: out_type list;
ocstr_return_type: out_type option;
}

and out_variant (*IF_CURRENT = Outcometree.out_variant *) =
| Ovar_fields of (string * bool * out_type list) list
| Ovar_typ of out_type

type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) =
| Octy_constr of out_ident * out_type list
| Octy_arrow of Asttypes.arg_label * out_type * out_class_type
| Octy_signature of out_type option * out_class_sig_item list
and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) =
| Ocsg_constraint of out_type * out_type
| Ocsg_method of string * bool * bool * out_type
| Ocsg_value of string * bool * bool * out_type

type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) =
| Omty_abstract
| Omty_functor of (string option * out_module_type) option * out_module_type
| Omty_ident of out_ident
| Omty_signature of out_sig_item list
| Omty_alias of out_ident
and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) =
| Osig_class of
bool * string * out_type_param list * out_class_type *
out_rec_status
| Osig_class_type of
bool * string * out_type_param list * out_class_type *
out_rec_status
| Osig_typext of out_extension_constructor * out_ext_status
| Osig_modtype of string * out_module_type
| Osig_module of string * out_module_type * out_rec_status
| Osig_type of out_type_decl * out_rec_status
| Osig_value of out_val_decl
| Osig_ellipsis
and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) =
{ otype_name: string;
otype_params: out_type_param list;
otype_type: out_type;
otype_private: Asttypes.private_flag;
otype_immediate: Type_immediacy.t;
otype_unboxed: bool;
otype_cstrs: (out_type * out_type) list }
and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) =
{ oext_name: string;
oext_type_name: string;
oext_type_params: string list;
oext_args: out_type list;
oext_ret_type: out_type option;
oext_private: Asttypes.private_flag }
and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) =
{ otyext_name: string;
otyext_params: string list;
otyext_constructors: out_constructor list;
otyext_private: Asttypes.private_flag }
and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) =
{ oval_name: string;
oval_type: out_type;
oval_prims: string list;
oval_attributes: out_attribute list }
and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) =
| Orec_not
| Orec_first
| Orec_next
and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) =
| Oext_first
| Oext_next
| Oext_exception

type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) =
| Ophr_eval of out_value * out_type
| Ophr_signature of (out_sig_item * out_value option) list
| Ophr_exception of (exn * out_value)
end
18 changes: 1 addition & 17 deletions src/vendored-omp/src/cinaps_helpers
Original file line number Diff line number Diff line change
Expand Up @@ -21,22 +21,10 @@ let supported_versions = [
("414", "4.14");
("5.0", "5.0");
("5.1", "5.1");
("5.2", "5.2");
]

let qualified_types = [
"Parsetree",
[ "structure"
; "signature"
; "toplevel_phrase"
; "core_type"
; "expression"
; "pattern"
; "case"
; "type_declaration"
; "type_extension"
; "extension_constructor"
];

"Outcometree",
[ "out_value"
; "out_type"
Expand All @@ -46,10 +34,6 @@ let qualified_types = [
; "out_type_extension"
; "out_phrase"
];

"Ast_mapper",
[ "mapper"
];
]

let all_types = List.concat (List.map ~f:snd qualified_types)
Expand Down
28 changes: 28 additions & 0 deletions src/vendored-omp/src/compiler-functions/ge_52.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
let error_of_exn exn =
match Location.error_of_exn exn with
| Some (`Ok exn) -> Some exn
| Some `Already_displayed -> None
| None -> None

let get_load_paths () =
Load_path.get_paths ()

let load_path_init l =
let auto_include find_in_dir fn =
if !Clflags.no_std_include then
raise Not_found
else
let alert = Location.auto_include_alert in
Load_path.auto_include_otherlibs alert find_in_dir fn
in
Load_path.init ~auto_include ~visible:l ~hidden:[]

let get_unboxed_types () =
!Clflags.unboxed_types

let set_unboxed_types b =
Clflags.unboxed_types := b

let may_map = Option.map

let bad_docstring t = Warnings.Unexpected_docstring t
5 changes: 4 additions & 1 deletion src/vendored-omp/src/config/gen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ let () =
| (4, 14) -> "414"
| (5, 0) -> "500"
| (5, 1) -> "51"
| (5, 2) -> "52"
| _ ->
Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str;
exit 1);
Expand All @@ -39,6 +40,8 @@ let () =
"ge_410_and_lt_412.ml"
else if ocaml_version < (5, 00) then
"ge_412.ml"
else
else if ocaml_version < (5, 2) then
"ge_50.ml"
else
"ge_52.ml"
)
2 changes: 2 additions & 0 deletions src/vendored-omp/src/migrate_parsetree_51_52.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@

include Migrate_parsetree_51_52_migrate
Loading

0 comments on commit f32f244

Please sign in to comment.