Skip to content

Commit

Permalink
OCaml 5.3 support
Browse files Browse the repository at this point in the history
  • Loading branch information
anmonteiro committed Oct 19, 2024
1 parent 54b4a47 commit 157233f
Show file tree
Hide file tree
Showing 17 changed files with 1,561 additions and 49 deletions.
6 changes: 6 additions & 0 deletions rtop/dune
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,12 @@
(action
(run cppo -V OCAML:%{ocaml_version} %{deps} -o %{targets})))

(rule
(targets reason_utop.ml)
(deps reason_utop.cppo.ml)
(action
(run cppo -V OCAML:%{ocaml_version} %{deps} -o %{targets})))

(executable
(name rtop)
(public_name rtop)
Expand Down
26 changes: 19 additions & 7 deletions rtop/reason_utop.ml → rtop/reason_utop.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -64,19 +64,31 @@ let init_reason () =

(* Printing in Reason syntax *)
let open Reason_toolchain.From_current in
let wrap f g fmt x = g fmt (f x) in
let wrap f g fmt x =
g fmt (f x)
in
#if OCAML_VERSION >= (5,3,0)
let wrap_doc f g fmt x =
let doc_f =
Format_doc.deprecated_printer (fun fmt -> Format.fprintf fmt "%a" g (f x))
in
doc_f fmt
#else
let wrap_doc = wrap
#endif
in
Toploop.print_out_value := wrap copy_out_value Reason_oprint.print_out_value;
Toploop.print_out_type := wrap copy_out_type Reason_oprint.print_out_type;
Toploop.print_out_type := wrap_doc copy_out_type Reason_oprint.print_out_type;
Toploop.print_out_class_type :=
wrap copy_out_class_type Reason_oprint.print_out_class_type;
wrap_doc copy_out_class_type Reason_oprint.print_out_class_type;
Toploop.print_out_module_type :=
wrap copy_out_module_type Reason_oprint.print_out_module_type;
wrap_doc copy_out_module_type Reason_oprint.print_out_module_type;
Toploop.print_out_type_extension :=
wrap copy_out_type_extension Reason_oprint.print_out_type_extension;
wrap_doc copy_out_type_extension Reason_oprint.print_out_type_extension;
Toploop.print_out_sig_item :=
wrap copy_out_sig_item Reason_oprint.print_out_sig_item;
wrap_doc copy_out_sig_item Reason_oprint.print_out_sig_item;
Toploop.print_out_signature :=
wrap (List.map copy_out_sig_item) Reason_oprint.print_out_signature;
wrap_doc (List.map copy_out_sig_item) Reason_oprint.print_out_signature;
Toploop.print_out_phrase :=
wrap copy_out_phrase Reason_oprint.print_out_phrase;
let current_show_fn =
Expand Down
12 changes: 11 additions & 1 deletion src/reason-parser/ocaml_util.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,17 @@ let print_loc ppf loc =


let print_error loc f ppf x =
#if OCAML_VERSION >= (4,8,0)
#if OCAML_VERSION >= (5,3,0)
let error =
let f (fmt: Format_doc.formatter) err =
let doc_f =
Format_doc.deprecated_printer (fun fmt -> Format.fprintf fmt "%a" f err)
in
doc_f fmt
in
Location.error_of_printer ~loc f x in
Location.print_report ppf error
#elif OCAML_VERSION >= (4,8,0)
let error = Location.error_of_printer ~loc f x in
Location.print_report ppf error
#else
Expand Down
207 changes: 207 additions & 0 deletions src/vendored-omp/src/ast_53.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,207 @@
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 (Caml_format_doc.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 out_label 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_label (*IF_CURRENT = Outcometree.out_label *) = {
olab_name: string;
olab_mut: Asttypes.mutable_flag;
olab_type: out_type;
}

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
Loading

0 comments on commit 157233f

Please sign in to comment.