From a9c046a266e7fd1396976fef3642f3c2b0cf6241 Mon Sep 17 00:00:00 2001
From: Kate <kit.ty.kate@disroot.org>
Date: Wed, 1 Jan 2020 20:30:35 +0100
Subject: [PATCH] Add support for OCaml 4.10
---
lib/versdep.ml | 55 ++++++++++++++++++++----
ocaml_src/lib/versdep/4.10.0.ml | 16 +++----
ocaml_stuff/4.10.0/parsing/location.mli | 7 +++
ocaml_stuff/4.10.0/parsing/parsetree.mli | 23 +++++++---
ocaml_stuff/4.10.0/utils/pconfig.ml | 4 +-
ocaml_stuff/4.10.0/utils/warnings.mli | 1 +
top/rprint.ml | 14 +++++-
7 files changed, 94 insertions(+), 26 deletions(-)
diff --git a/lib/versdep.ml b/lib/versdep.ml
index d4b084ec..97f6e521 100644
--- a/lib/versdep.ml
+++ b/lib/versdep.ml
@@ -308,7 +308,8 @@ value ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);
value ocaml_pmty_functor sloc s mt1 mt2 =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Pmty_functor (mkloc sloc s) mt1 mt2
- ELSE Pmty_functor (mkloc sloc s) (Some mt1) mt2 END
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN Pmty_functor (mkloc sloc s) (Some mt1) mt2
+ ELSE Pmty_functor (Named (mkloc sloc (Some s)) mt1) mt2 END
;
value ocaml_pmty_typeof =
@@ -764,7 +765,8 @@ value ocaml_pexp_ident loc li = Pexp_ident (mkloc loc li);
value ocaml_pexp_letmodule =
IFDEF OCAML_VERSION <= OCAML_1_07 THEN None
- ELSE Some (fun i me e -> Pexp_letmodule (mknoloc i) me e) END
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN Some (fun i me e -> Pexp_letmodule (mknoloc i) me e)
+ ELSE Some (fun i me e -> Pexp_letmodule (mknoloc (Some i)) me e) END
;
value ocaml_pexp_new loc li = Pexp_new (mkloc loc li);
@@ -929,8 +931,10 @@ value ocaml_ppat_type =
value ocaml_ppat_unpack =
IFDEF OCAML_VERSION < OCAML_3_13_0 OR JOCAML THEN None
- ELSE
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN
Some (fun loc s -> Ppat_unpack (mkloc loc s), fun pt -> Ptyp_package pt)
+ ELSE
+ Some (fun loc s -> Ppat_unpack (mkloc loc (Some s)), fun pt -> Ptyp_package pt)
END
;
@@ -984,10 +988,14 @@ value ocaml_psig_include loc mt =
value ocaml_psig_module loc s mt =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Psig_module (mknoloc s) mt
- ELSE
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN
Psig_module
{pmd_name = mkloc loc s; pmd_type = mt; pmd_attributes = [];
pmd_loc = loc}
+ ELSE
+ Psig_module
+ {pmd_name = mkloc loc (Some s); pmd_type = mt; pmd_attributes = [];
+ pmd_loc = loc}
END
;
@@ -1031,7 +1039,7 @@ value ocaml_psig_recmodule =
Psig_recmodule ntl
in
Some f
- ELSE
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN
let f ntl =
let ntl =
List.map
@@ -1043,6 +1051,18 @@ value ocaml_psig_recmodule =
Psig_recmodule ntl
in
Some f
+ ELSE
+ let f ntl =
+ let ntl =
+ List.map
+ (fun (s, mt) ->
+ {pmd_name = mknoloc (Some s); pmd_type = mt; pmd_attributes = [];
+ pmd_loc = loc_none})
+ ntl
+ in
+ Psig_recmodule ntl
+ in
+ Some f
END
;
@@ -1141,12 +1161,18 @@ value ocaml_pstr_modtype loc s mt =
value ocaml_pstr_module loc s me =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Pstr_module (mkloc loc s) me
- ELSE
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN
let mb =
{pmb_name = mkloc loc s; pmb_expr = me; pmb_attributes = [];
pmb_loc = loc}
in
Pstr_module mb
+ ELSE
+ let mb =
+ {pmb_name = mkloc loc (Some s); pmb_expr = me; pmb_attributes = [];
+ pmb_loc = loc}
+ in
+ Pstr_module mb
END
;
@@ -1185,7 +1211,7 @@ value ocaml_pstr_recmodule =
Pstr_recmodule (List.map (fun (s, mt, me) → (mknoloc s, mt, me)) nel)
in
Some f
- ELSE
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN
let f nel =
Pstr_recmodule
(List.map
@@ -1195,6 +1221,16 @@ value ocaml_pstr_recmodule =
nel)
in
Some f
+ ELSE
+ let f nel =
+ Pstr_recmodule
+ (List.map
+ (fun (s, mt, me) ->
+ {pmb_name = mknoloc (Some s); pmb_expr = me; pmb_attributes = [];
+ pmb_loc = loc_none})
+ nel)
+ in
+ Some f
END
;
@@ -1252,7 +1288,8 @@ value ocaml_pmod_ident li = Pmod_ident (mknoloc li);
value ocaml_pmod_functor s mt me =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Pmod_functor (mknoloc s) mt me
- ELSE Pmod_functor (mknoloc s) (Some mt) me END
+ ELSIFDEF OCAML_VERSION < OCAML_4_10_0 THEN Pmod_functor (mknoloc s) (Some mt) me
+ ELSE Pmod_functor (Named (mknoloc (Some s)) mt) me END
;
value ocaml_pmod_unpack =
@@ -1813,3 +1850,5 @@ value array_create =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Array.create
ELSE Array.make END
;
+
+value uv_opt c = IFDEF OCAML_VERSION >= OCAML_4_10_0 THEN Some c ELSE c END;
diff --git a/ocaml_src/lib/versdep/4.10.0.ml b/ocaml_src/lib/versdep/4.10.0.ml
index 640184e3..f34a5a2c 100644
--- a/ocaml_src/lib/versdep/4.10.0.ml
+++ b/ocaml_src/lib/versdep/4.10.0.ml
@@ -153,7 +153,7 @@ let ocaml_class_structure p cil = {pcstr_self = p; pcstr_fields = cil};;
let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);;
let ocaml_pmty_functor sloc s mt1 mt2 =
- Pmty_functor (mkloc sloc s, Some mt1, mt2)
+ Pmty_functor (Named (mkloc sloc (Some s), mt1), mt2)
;;
let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);;
@@ -316,7 +316,7 @@ let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);;
let ocaml_pexp_ident loc li = Pexp_ident (mkloc loc li);;
let ocaml_pexp_letmodule =
- Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e))
+ Some (fun i me e -> Pexp_letmodule (mknoloc (Some i), me, e))
;;
let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);;
@@ -403,7 +403,7 @@ let ocaml_ppat_record lpl is_closed =
let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));;
let ocaml_ppat_unpack =
- Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt))
+ Some ((fun loc s -> Ppat_unpack (mkloc loc (Some s))), (fun pt -> Ptyp_package pt))
;;
let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);;
@@ -434,7 +434,7 @@ let ocaml_psig_include loc mt =
let ocaml_psig_module loc s mt =
Psig_module
- {pmd_name = mkloc loc s; pmd_type = mt; pmd_attributes = [];
+ {pmd_name = mkloc loc (Some s); pmd_type = mt; pmd_attributes = [];
pmd_loc = loc}
;;
@@ -457,7 +457,7 @@ let ocaml_psig_recmodule =
let ntl =
List.map
(fun (s, mt) ->
- {pmd_name = mknoloc s; pmd_type = mt; pmd_attributes = [];
+ {pmd_name = mknoloc (Some s); pmd_type = mt; pmd_attributes = [];
pmd_loc = loc_none})
ntl
in
@@ -510,7 +510,7 @@ let ocaml_pstr_modtype loc s mt =
let ocaml_pstr_module loc s me =
let mb =
- {pmb_name = mkloc loc s; pmb_expr = me; pmb_attributes = [];
+ {pmb_name = mkloc loc (Some s); pmb_expr = me; pmb_attributes = [];
pmb_loc = loc}
in
Pstr_module mb
@@ -531,7 +531,7 @@ let ocaml_pstr_recmodule =
Pstr_recmodule
(List.map
(fun (s, mt, me) ->
- {pmb_name = mknoloc s; pmb_expr = me; pmb_attributes = [];
+ {pmb_name = mknoloc (Some s); pmb_expr = me; pmb_attributes = [];
pmb_loc = loc_none})
nel)
in
@@ -566,7 +566,7 @@ let ocaml_pmod_constraint loc me mt =
let ocaml_pmod_ident li = Pmod_ident (mknoloc li);;
-let ocaml_pmod_functor s mt me = Pmod_functor (mknoloc s, Some mt, me);;
+let ocaml_pmod_functor s mt me = Pmod_functor (Named (mknoloc (Some s), mt), me);;
let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option =
Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt)))
diff --git a/ocaml_stuff/4.10.0/parsing/location.mli b/ocaml_stuff/4.10.0/parsing/location.mli
index b1c3e013..784c9694 100644
--- a/ocaml_stuff/4.10.0/parsing/location.mli
+++ b/ocaml_stuff/4.10.0/parsing/location.mli
@@ -74,6 +74,13 @@ val mkloc : 'a -> t -> 'a loc
val input_name: string ref
val input_lexbuf: Lexing.lexbuf option ref
+(* This is used for reporting errors coming from the toplevel.
+
+ When running a toplevel session (i.e. when [!input_name] is "//toplevel//"),
+ [!input_phrase_buffer] should be [Some buf] where [buf] contains the last
+ toplevel phrase. *)
+val input_phrase_buffer: Buffer.t option ref
+
(** {1 Toplevel-specific functions} *)
diff --git a/ocaml_stuff/4.10.0/parsing/parsetree.mli b/ocaml_stuff/4.10.0/parsing/parsetree.mli
index 40462498..3f943210 100644
--- a/ocaml_stuff/4.10.0/parsing/parsetree.mli
+++ b/ocaml_stuff/4.10.0/parsing/parsetree.mli
@@ -238,8 +238,10 @@ and pattern_desc =
(* #tconst *)
| Ppat_lazy of pattern
(* lazy P *)
- | Ppat_unpack of string loc
- (* (module P)
+ | Ppat_unpack of string option loc
+ (* (module P) Some "P"
+ (module _) None
+
Note: (module P : S) is represented as
Ppat_constraint(Ppat_unpack, Ptyp_package)
*)
@@ -346,7 +348,7 @@ and expression_desc =
(* x <- 2 *)
| Pexp_override of (label loc * expression) list
(* {< x1 = E1; ...; Xn = En >} *)
- | Pexp_letmodule of string loc * module_expr * expression
+ | Pexp_letmodule of string option loc * module_expr * expression
(* let module M = ME in E *)
| Pexp_letexception of extension_constructor * expression
(* let exception C in E *)
@@ -713,7 +715,7 @@ and module_type_desc =
(* S *)
| Pmty_signature of signature
(* sig ... end *)
- | Pmty_functor of string loc * module_type option * module_type
+ | Pmty_functor of functor_parameter * module_type
(* functor(X : MT1) -> MT2 *)
| Pmty_with of module_type * with_constraint list
(* MT with ... *)
@@ -724,6 +726,13 @@ and module_type_desc =
| Pmty_alias of Longident.t loc
(* (module M) *)
+and functor_parameter =
+ | Unit
+ (* () *)
+ | Named of string option loc * module_type
+ (* (X : MT) Some X, MT
+ (_ : MT) None, MT *)
+
and signature = signature_item list
and signature_item =
@@ -771,7 +780,7 @@ and signature_item_desc =
and module_declaration =
{
- pmd_name: string loc;
+ pmd_name: string option loc;
pmd_type: module_type;
pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
pmd_loc: Location.t;
@@ -858,7 +867,7 @@ and module_expr_desc =
(* X *)
| Pmod_structure of structure
(* struct ... end *)
- | Pmod_functor of string loc * module_type option * module_expr
+ | Pmod_functor of functor_parameter * module_expr
(* functor(X : MT1) -> ME *)
| Pmod_apply of module_expr * module_expr
(* ME1(ME2) *)
@@ -923,7 +932,7 @@ and value_binding =
and module_binding =
{
- pmb_name: string loc;
+ pmb_name: string option loc;
pmb_expr: module_expr;
pmb_attributes: attributes;
pmb_loc: Location.t;
diff --git a/ocaml_stuff/4.10.0/utils/pconfig.ml b/ocaml_stuff/4.10.0/utils/pconfig.ml
index 64595721..cc05fde1 100644
--- a/ocaml_stuff/4.10.0/utils/pconfig.ml
+++ b/ocaml_stuff/4.10.0/utils/pconfig.ml
@@ -1,2 +1,2 @@
-let ast_impl_magic_number = "Caml1999M025"
-let ast_intf_magic_number = "Caml1999N025"
+let ast_impl_magic_number = "Caml1999M027"
+let ast_intf_magic_number = "Caml1999N027"
diff --git a/ocaml_stuff/4.10.0/utils/warnings.mli b/ocaml_stuff/4.10.0/utils/warnings.mli
index 4fe4964f..b80ab34c 100644
--- a/ocaml_stuff/4.10.0/utils/warnings.mli
+++ b/ocaml_stuff/4.10.0/utils/warnings.mli
@@ -93,6 +93,7 @@ type t =
| Unsafe_without_parsing (* 64 *)
| Redefining_unit of string (* 65 *)
| Unused_open_bang of string (* 66 *)
+ | Unused_functor_parameter of string (* 67 *)
;;
type alert = {kind:string; message:string; def:loc; use:loc}
diff --git a/top/rprint.ml b/top/rprint.ml
index ee207fc5..69f37388 100644
--- a/top/rprint.ml
+++ b/top/rprint.ml
@@ -435,7 +435,7 @@ value rec print_out_module_type ppf =
[ Omty_ident id -> fprintf ppf "%a" print_ident id
| Omty_signature sg ->
fprintf ppf "@[<hv 2>sig@ %a@;<1 -2>end@]" print_out_signature sg
- | Omty_functor name mty_arg mty_res ->
+ | IFDEF OCAML_VERSION < OCAML_4_10_0 THEN Omty_functor name mty_arg mty_res ->
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN
fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
print_out_module_type mty_arg print_out_module_type mty_res
@@ -448,6 +448,18 @@ value rec print_out_module_type ppf =
fprintf ppf "@[<2>functor@ (%s) ->@ %a@]" name
print_out_module_type mty_res ]
END
+ ELSE Omty_functor mty_arg mty_res ->
+ match mty_arg with
+ [ Some (Some name, mty_arg) ->
+ fprintf ppf "@[<2>functor@ (%s : %a) ->@ %a@]" name
+ print_out_module_type mty_arg print_out_module_type mty_res
+ | Some (None, mty_arg) ->
+ fprintf ppf "@[<2>functor@ (_ : %a) ->@ %a@]"
+ print_out_module_type mty_arg print_out_module_type mty_res
+ | None ->
+ fprintf ppf "@[<2>functor@ () ->@ %a@]"
+ print_out_module_type mty_res ]
+ END
| Omty_abstract -> ()
| IFDEF OCAML_VERSION >= OCAML_4_02_0 THEN
Omty_alias oi -> fprintf ppf "<rprint.ml: Omty_alias not impl>"
--
2.24.1