384 lines
13 KiB
Diff
384 lines
13 KiB
Diff
|
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
|
||
|
|