rpms/ocaml-camlp5
3
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
512923173e
ocaml-camlp5/0007-start-on-4.11.0.patch
Richard W.M. Jones 9b92758266 Include all upstream pre-7.12 patches. 
Fixes support for OCaml 4.11.
2020-05-04 17:36:07 +01:00

2610 lines
78 KiB
Diff
Raw Blame History

From f137332fdb7376f742f1c3c184764cb562ea931e Mon Sep 17 00:00:00 2001
From: Chet Murthy <chetsky@gmail.com>
Date: Wed, 29 Apr 2020 11:38:50 -0700
Subject: [PATCH 07/10] start on 4.11.0
---
lib/versdep.ml | 19 +-
main/ast2pt.ml | 4 +-
main/ast2pt.mli | 3 +
ocaml_src/lib/versdep/4.11.0.ml | 808 +++++++++++++++++++
ocaml_src/main/ast2pt.ml | 4 +-
ocaml_stuff/4.11.0/parsing/.depend | 4 +
ocaml_stuff/4.11.0/parsing/.gitignore | 1 +
ocaml_stuff/4.11.0/parsing/Makefile | 19 +
ocaml_stuff/4.11.0/parsing/asttypes.mli | 63 ++
ocaml_stuff/4.11.0/parsing/location.mli | 287 +++++++
ocaml_stuff/4.11.0/parsing/longident.mli | 60 ++
ocaml_stuff/4.11.0/parsing/parsetree.mli | 970 +++++++++++++++++++++++
ocaml_stuff/4.11.0/utils/.depend | 2 +
ocaml_stuff/4.11.0/utils/.gitignore | 1 +
ocaml_stuff/4.11.0/utils/Makefile | 27 +
ocaml_stuff/4.11.0/utils/pconfig.ml | 2 +
ocaml_stuff/4.11.0/utils/pconfig.mli | 2 +
ocaml_stuff/4.11.0/utils/warnings.mli | 140 ++++
18 files changed, 2407 insertions(+), 9 deletions(-)
create mode 100644 ocaml_src/lib/versdep/4.11.0.ml
create mode 100644 ocaml_stuff/4.11.0/parsing/.depend
create mode 100644 ocaml_stuff/4.11.0/parsing/.gitignore
create mode 100644 ocaml_stuff/4.11.0/parsing/Makefile
create mode 100644 ocaml_stuff/4.11.0/parsing/asttypes.mli
create mode 100644 ocaml_stuff/4.11.0/parsing/location.mli
create mode 100644 ocaml_stuff/4.11.0/parsing/longident.mli
create mode 100644 ocaml_stuff/4.11.0/parsing/parsetree.mli
create mode 100644 ocaml_stuff/4.11.0/utils/.depend
create mode 100644 ocaml_stuff/4.11.0/utils/.gitignore
create mode 100644 ocaml_stuff/4.11.0/utils/Makefile
create mode 100644 ocaml_stuff/4.11.0/utils/pconfig.ml
create mode 100644 ocaml_stuff/4.11.0/utils/pconfig.mli
create mode 100644 ocaml_stuff/4.11.0/utils/warnings.mli
diff --git a/lib/versdep.ml b/lib/versdep.ml
index b766160a..1481e265 100644
--- a/lib/versdep.ml
+++ b/lib/versdep.ml
@@ -583,14 +583,19 @@ value ocaml_pconst_float s =
ELSE Pconst_float s None END
;
-value ocaml_const_string s =
+value ocaml_const_string s loc =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Const_string s
- ELSE Const_string s None END
+ ELSIFDEF OCAML_VERSION < OCAML_4_11_0 THEN
+ Const_string s None
+ ELSE
+ Const_string s loc None
+ END
;
-value ocaml_pconst_string s so =
+value ocaml_pconst_string s loc so =
IFDEF OCAML_VERSION < OCAML_4_02_0 THEN Const_string s
ELSIFDEF OCAML_VERSION < OCAML_4_03_0 THEN Const_string s so
- ELSE Pconst_string s so END
+ ELSIFDEF OCAML_VERSION < OCAML_4_11_0 THEN Pconst_string s so
+ ELSE Pconst_string s loc so END
;
value pconst_of_const =
@@ -617,7 +622,11 @@ value pconst_of_const =
fun
[ Const_int i -> ocaml_pconst_int i
| Const_char c -> ocaml_pconst_char c
- | Const_string s so -> ocaml_pconst_string s so
+ | IFDEF OCAML_VERSION < OCAML_4_11_0 THEN
+ Const_string s so -> ocaml_pconst_string s so
+ ELSE
+ Const_string s loc so -> ocaml_pconst_string s loc so
+ END
| Const_float s -> ocaml_pconst_float s
| Const_int32 i32 -> Pconst_integer (Int32.to_string i32) (Some 'l')
| Const_int64 i64 -> Pconst_integer (Int64.to_string i64) (Some 'L')
diff --git a/main/ast2pt.ml b/main/ast2pt.ml
index b280ac19..4b97a074 100644
--- a/main/ast2pt.ml
+++ b/main/ast2pt.ml
@@ -607,7 +607,7 @@ value rec patt =
| PaStr loc s →
mkpat loc
(Ppat_constant
- (ocaml_pconst_string (string_of_string_token loc (uv s)) None))
+ (ocaml_pconst_string (string_of_string_token loc (uv s)) (mkloc loc) None))
| PaTup loc pl → mkpat loc (Ppat_tuple (List.map patt (uv pl)))
| PaTyc loc p t → mkpat loc (Ppat_constraint (patt p) (ctyp t))
| PaTyp loc sl →
@@ -1045,7 +1045,7 @@ value rec expr =
| ExStr loc s →
mkexp loc
(Pexp_constant
- (ocaml_pconst_string (string_of_string_token loc (uv s)) None))
+ (ocaml_pconst_string (string_of_string_token loc (uv s)) (mkloc loc) None))
| ExTry loc e pel → mkexp loc (Pexp_try (expr e) (List.map mkpwe (uv pel)))
| ExTup loc el → mkexp loc (Pexp_tuple (List.map expr (uv el)))
| ExTyc loc e t →
diff --git a/main/ast2pt.mli b/main/ast2pt.mli
index 949af7d7..80b54dc3 100644
--- a/main/ast2pt.mli
+++ b/main/ast2pt.mli
@@ -15,3 +15,6 @@ value mkloc : Ploc.t -> Location.t;
(** Convert a Camlp5 location into an OCaml location. *)
value fast : ref bool;
(** Flag to generate fast (unsafe) access to arrays. Default: False. *)
+value ctyp : MLast.ctyp -> Parsetree.core_type ;
+value expr : MLast.expr -> Parsetree.expression ;
+value patt : MLast.patt -> Parsetree.pattern ;
diff --git a/ocaml_src/lib/versdep/4.11.0.ml b/ocaml_src/lib/versdep/4.11.0.ml
new file mode 100644
index 00000000..bb7124dd
--- /dev/null
+++ b/ocaml_src/lib/versdep/4.11.0.ml
@@ -0,0 +1,808 @@
+(* camlp5r pa_macro.cmo *)
+(* versdep.ml,v *)
+(* Copyright (c) INRIA 2007-2017 *)
+
+open Parsetree;;
+open Longident;;
+open Asttypes;;
+
+type ('a, 'b) choice =
+ Left of 'a
+ | Right of 'b
+;;
+
+let option_map f x =
+ match x with
+ Some x -> Some (f x)
+ | None -> None
+;;
+let mustSome symbol =
+ function
+ Some x -> x
+ | None -> failwith ("Some: " ^ symbol)
+;;
+
+let ocaml_name = "ocaml";;
+
+let sys_ocaml_version = Sys.ocaml_version;;
+
+let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) =
+ let loc_at n lnum bolp =
+ {Lexing.pos_fname = if lnum = -1 then "" else fname;
+ Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n}
+ in
+ {Location.loc_start = loc_at bp lnum bolp;
+ Location.loc_end = loc_at ep lnuml bolpl;
+ Location.loc_ghost = bp = 0 && ep = 0}
+;;
+
+let loc_none =
+ let loc =
+ {Lexing.pos_fname = "_none_"; Lexing.pos_lnum = 1; Lexing.pos_bol = 0;
+ Lexing.pos_cnum = -1}
+ in
+ {Location.loc_start = loc; Location.loc_end = loc;
+ Location.loc_ghost = true}
+;;
+
+let mkloc loc txt = {Location.txt = txt; Location.loc = loc};;
+let mknoloc txt = mkloc loc_none txt;;
+
+let ocaml_id_or_li_of_string_list loc sl =
+ let mkli s =
+ let rec loop f =
+ function
+ i :: il -> loop (fun s -> Ldot (f i, s)) il
+ | [] -> f s
+ in
+ loop (fun s -> Lident s)
+ in
+ match List.rev sl with
+ [] -> None
+ | s :: sl -> Some (mkli s (List.rev sl))
+;;
+
+let list_map_check f l =
+ let rec loop rev_l =
+ function
+ x :: l ->
+ begin match f x with
+ Some s -> loop (s :: rev_l) l
+ | None -> None
+ end
+ | [] -> Some (List.rev rev_l)
+ in
+ loop [] l
+;;
+
+let labelled lab =
+ if lab = "" then Nolabel
+ else if lab.[0] = '?' then
+ Optional (String.sub lab 1 (String.length lab - 1))
+ else Labelled lab
+;;
+
+(* *)
+
+let ocaml_value_description vn t p =
+ {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc;
+ pval_name = mkloc t.ptyp_loc vn; pval_attributes = []}
+;;
+
+let ocaml_class_type_field loc ctfd =
+ {pctf_desc = ctfd; pctf_loc = loc; pctf_attributes = []}
+;;
+
+let ocaml_class_field loc cfd =
+ {pcf_desc = cfd; pcf_loc = loc; pcf_attributes = []}
+;;
+
+let ocaml_mktyp loc x =
+ {ptyp_desc = x; ptyp_loc = loc; ptyp_loc_stack = []; ptyp_attributes = []}
+;;
+let ocaml_mkpat loc x =
+ {ppat_desc = x; ppat_loc = loc; ppat_loc_stack = []; ppat_attributes = []}
+;;
+let ocaml_mkexp loc x =
+ {pexp_desc = x; pexp_loc = loc; pexp_loc_stack = []; pexp_attributes = []}
+;;
+let ocaml_mkmty loc x =
+ {pmty_desc = x; pmty_loc = loc; pmty_attributes = []}
+;;
+let ocaml_mkmod loc x =
+ {pmod_desc = x; pmod_loc = loc; pmod_attributes = []}
+;;
+let ocaml_mkfield loc (lab, x) fl =
+ {pof_desc = Otag (mkloc loc lab, x); pof_loc = loc; pof_attributes = []} ::
+ fl
+;;
+let ocaml_mkfield_var loc = [];;
+
+let variance_of_bool_bool =
+ function
+ false, true -> Contravariant
+ | true, false -> Covariant
+ | _ -> Invariant
+;;
+
+let ocaml_type_declaration tn params cl tk pf tm loc variance =
+ match list_map_check (fun s_opt -> s_opt) params with
+ Some params ->
+ let _ =
+ if List.length params <> List.length variance then
+ failwith "internal error: ocaml_type_declaration"
+ in
+ let params =
+ List.map2
+ (fun os va ->
+ ocaml_mktyp loc (Ptyp_var os), variance_of_bool_bool va)
+ params variance
+ in
+ Right
+ {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk;
+ ptype_private = pf; ptype_manifest = tm; ptype_loc = loc;
+ ptype_name = mkloc loc tn; ptype_attributes = []}
+ | None -> Left "no '_' type param in this ocaml version"
+;;
+
+let ocaml_class_type =
+ Some (fun d loc -> {pcty_desc = d; pcty_loc = loc; pcty_attributes = []})
+;;
+
+let ocaml_class_expr =
+ Some (fun d loc -> {pcl_desc = d; pcl_loc = loc; pcl_attributes = []})
+;;
+
+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 mt1 mt2 =
+ let mt1 =
+ match mt1 with
+ None -> Unit
+ | Some (idopt, mt) -> Named (mknoloc idopt, mt)
+ in
+ Pmty_functor (mt1, mt2)
+;;
+
+let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);;
+
+let ocaml_pmty_with mt lcl =
+ let lcl = List.map snd lcl in Pmty_with (mt, lcl)
+;;
+
+let ocaml_ptype_abstract = Ptype_abstract;;
+
+let ocaml_ptype_record ltl priv =
+ Ptype_record
+ (List.map
+ (fun (s, mf, ct, loc) ->
+ {pld_name = mkloc loc s; pld_mutable = mf; pld_type = ct;
+ pld_loc = loc; pld_attributes = []})
+ ltl)
+;;
+
+let ocaml_ptype_variant ctl priv =
+ try
+ let ctl =
+ List.map
+ (fun (c, tl, rto, loc) ->
+ if rto <> None then raise Exit
+ else
+ let tl = Pcstr_tuple tl in
+ {pcd_name = mkloc loc c; pcd_args = tl; pcd_res = None;
+ pcd_loc = loc; pcd_attributes = []})
+ ctl
+ in
+ Some (Ptype_variant ctl)
+ with Exit -> None
+;;
+
+let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (labelled lab, t1, t2);;
+
+let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl);;
+
+let ocaml_ptyp_constr loc li tl = Ptyp_constr (mkloc loc li, tl);;
+
+let ocaml_ptyp_object loc ml is_open =
+ Ptyp_object (ml, (if is_open then Open else Closed))
+;;
+
+let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);;
+
+let ocaml_ptyp_poly =
+ Some
+ (fun loc cl t ->
+ match cl with
+ [] -> t.ptyp_desc
+ | _ -> Ptyp_poly (List.map (mkloc loc) cl, t))
+;;
+
+let ocaml_ptyp_variant loc catl clos sl_opt =
+ let catl =
+ List.map
+ (fun c ->
+ let d =
+ match c with
+ Left (c, a, tl) -> Rtag (mkloc loc c, a, tl)
+ | Right t -> Rinherit t
+ in
+ {prf_desc = d; prf_loc = loc; prf_attributes = []})
+ catl
+ in
+ let clos = if clos then Closed else Open in
+ Some (Ptyp_variant (catl, clos, sl_opt))
+;;
+
+let ocaml_package_type li ltl =
+ mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl
+;;
+
+let ocaml_pconst_char c = Pconst_char c;;
+let ocaml_pconst_int i = Pconst_integer (string_of_int i, None);;
+let ocaml_pconst_float s = Pconst_float (s, None);;
+
+let ocaml_const_string s = Const_string (s, None);;
+let ocaml_pconst_string s so = Pconst_string (s, so);;
+
+let pconst_of_const =
+ function
+ Const_int i -> ocaml_pconst_int i
+ | Const_char c -> ocaml_pconst_char c
+ | Const_string (s, so) -> ocaml_pconst_string s so
+ | Const_float s -> ocaml_pconst_float s
+ | Const_int32 i32 -> Pconst_integer (Int32.to_string i32, Some 'l')
+ | Const_int64 i64 -> Pconst_integer (Int64.to_string i64, Some 'L')
+ | Const_nativeint ni -> Pconst_integer (Nativeint.to_string ni, Some 'n')
+;;
+
+let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));;
+
+let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));;
+
+let ocaml_const_nativeint =
+ Some (fun s -> Const_nativeint (Nativeint.of_string s))
+;;
+
+let ocaml_pexp_apply f lel =
+ Pexp_apply (f, List.map (fun (l, e) -> labelled l, e) lel)
+;;
+
+let ocaml_pexp_assertfalse fname loc =
+ Pexp_assert
+ (ocaml_mkexp loc (Pexp_construct (mkloc loc (Lident "false"), None)))
+;;
+
+let ocaml_pexp_assert fname loc e = Pexp_assert e;;
+
+let ocaml_pexp_constraint e ot1 ot2 =
+ match ot2 with
+ Some t2 -> Pexp_coerce (e, ot1, t2)
+ | None ->
+ match ot1 with
+ Some t1 -> Pexp_constraint (e, t1)
+ | None -> failwith "internal error: ocaml_pexp_constraint"
+;;
+
+let ocaml_pexp_construct loc li po chk_arity =
+ Pexp_construct (mkloc loc li, po)
+;;
+
+let ocaml_pexp_construct_args =
+ function
+ Pexp_construct (li, po) -> Some (li.txt, li.loc, po, 0)
+ | _ -> None
+;;
+
+let mkexp_ocaml_pexp_construct_arity loc li_loc li al =
+ let a = ocaml_mkexp loc (Pexp_tuple al) in
+ {pexp_desc = ocaml_pexp_construct li_loc li (Some a) true; pexp_loc = loc;
+ pexp_loc_stack = [];
+ pexp_attributes =
+ [{attr_name = mkloc loc "ocaml.explicit_arity"; attr_payload = PStr [];
+ attr_loc = loc}]}
+;;
+
+let ocaml_pexp_field loc e li = Pexp_field (e, mkloc loc li);;
+
+let ocaml_pexp_for i e1 e2 df e =
+ Pexp_for (ocaml_mkpat loc_none (Ppat_var (mknoloc i)), e1, e2, df, e)
+;;
+
+let ocaml_case (p, wo, loc, e) = {pc_lhs = p; pc_guard = wo; pc_rhs = e};;
+
+let ocaml_pexp_function lab eo pel =
+ match pel with
+ [{pc_lhs = p; pc_guard = None; pc_rhs = e}] ->
+ Pexp_fun (labelled lab, eo, p, e)
+ | pel ->
+ if lab = "" && eo = None then Pexp_function pel
+ else failwith "internal error: bad ast in ocaml_pexp_function"
+;;
+
+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))
+;;
+
+let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);;
+
+let ocaml_pexp_newtype = Some (fun loc s e -> Pexp_newtype (mkloc loc s, e));;
+
+let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);;
+
+let ocaml_pexp_open =
+ Some
+ (fun li e ->
+ Pexp_open
+ ({popen_expr =
+ {pmod_desc = Pmod_ident (mknoloc li); pmod_loc = loc_none;
+ pmod_attributes = []};
+ popen_override = Fresh; popen_loc = loc_none;
+ popen_attributes = []},
+ e))
+;;
+
+let ocaml_pexp_override sel =
+ let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel
+;;
+
+let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option =
+ Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt)))
+;;
+
+let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));;
+
+let ocaml_pexp_record lel eo =
+ let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in
+ Pexp_record (lel, eo)
+;;
+
+let ocaml_pexp_send loc e s = Pexp_send (e, mkloc loc s);;
+
+let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);;
+
+let ocaml_pexp_variant =
+ let pexp_variant_pat =
+ function
+ Pexp_variant (lab, eo) -> Some (lab, eo)
+ | _ -> None
+ in
+ let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in
+ Some (pexp_variant_pat, pexp_variant)
+;;
+
+let ocaml_value_binding loc p e =
+ {pvb_pat = p; pvb_expr = e; pvb_loc = loc; pvb_attributes = []}
+;;
+
+let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);;
+
+let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);;
+
+let ocaml_ppat_construct loc li po chk_arity =
+ Ppat_construct (mkloc loc li, po)
+;;
+
+let ocaml_ppat_construct_args =
+ function
+ Ppat_construct (li, po) -> Some (li.txt, li.loc, po, 0)
+ | _ -> None
+;;
+
+let mkpat_ocaml_ppat_construct_arity loc li_loc li al =
+ let a = ocaml_mkpat loc (Ppat_tuple al) in
+ {ppat_desc = ocaml_ppat_construct li_loc li (Some a) true; ppat_loc = loc;
+ ppat_loc_stack = [];
+ ppat_attributes =
+ [{attr_name = mkloc loc "ocaml.explicit_arity"; attr_payload = PStr [];
+ attr_loc = loc}]}
+;;
+
+let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);;
+
+let ocaml_ppat_record lpl is_closed =
+ let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in
+ Ppat_record (lpl, (if is_closed then Closed else Open))
+;;
+
+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))
+;;
+
+let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);;
+
+let ocaml_ppat_variant =
+ let ppat_variant_pat =
+ function
+ Ppat_variant (lab, po) -> Some (lab, po)
+ | _ -> None
+ in
+ let ppat_variant (lab, po) = Ppat_variant (lab, po) in
+ Some (ppat_variant_pat, ppat_variant)
+;;
+
+let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);;
+
+let ocaml_psig_exception loc s ed =
+ Psig_exception
+ {ptyexn_constructor =
+ {pext_name = mkloc loc s; pext_kind = Pext_decl (Pcstr_tuple ed, None);
+ pext_loc = loc; pext_attributes = []};
+ ptyexn_attributes = []; ptyexn_loc = loc}
+;;
+
+let ocaml_psig_include loc mt =
+ Psig_include {pincl_mod = mt; pincl_loc = loc; pincl_attributes = []}
+;;
+
+let ocaml_psig_module loc (s : string option) mt =
+ Psig_module
+ {pmd_name = mkloc loc s; pmd_type = mt; pmd_attributes = [];
+ pmd_loc = loc}
+;;
+
+let ocaml_psig_modtype loc s mto =
+ let pmtd =
+ {pmtd_name = mkloc loc s; pmtd_type = mto; pmtd_attributes = [];
+ pmtd_loc = loc}
+ in
+ Psig_modtype pmtd
+;;
+
+let ocaml_psig_open loc li =
+ Psig_open
+ {popen_expr = mknoloc li; popen_override = Fresh; popen_loc = loc;
+ popen_attributes = []}
+;;
+
+let ocaml_psig_recmodule =
+ let f ntl =
+ let ntl =
+ List.map
+ (fun (s, mt) ->
+ {pmd_name = mknoloc s; pmd_type = mt; pmd_attributes = [];
+ pmd_loc = loc_none})
+ ntl
+ in
+ Psig_recmodule ntl
+ in
+ Some f
+;;
+
+let ocaml_psig_type stl =
+ let stl = List.map (fun (s, t) -> t) stl in Psig_type (Recursive, stl)
+;;
+
+let ocaml_psig_value s vd = Psig_value vd;;
+
+let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);;
+
+let ocaml_pstr_eval e = Pstr_eval (e, []);;
+
+let ocaml_pstr_exception loc s ed =
+ Pstr_exception
+ {ptyexn_constructor =
+ {pext_name = mkloc loc s; pext_kind = Pext_decl (Pcstr_tuple ed, None);
+ pext_loc = loc; pext_attributes = []};
+ ptyexn_attributes = []; ptyexn_loc = loc}
+;;
+
+let ocaml_pstr_exn_rebind =
+ Some
+ (fun loc s li ->
+ Pstr_exception
+ {ptyexn_constructor =
+ {pext_name = mkloc loc s; pext_kind = Pext_rebind (mkloc loc li);
+ pext_loc = loc; pext_attributes = []};
+ ptyexn_attributes = []; ptyexn_loc = loc})
+;;
+
+let ocaml_pstr_include =
+ Some
+ (fun loc me ->
+ Pstr_include {pincl_mod = me; pincl_loc = loc; pincl_attributes = []})
+;;
+
+let ocaml_pstr_modtype loc s mt =
+ let pmtd =
+ {pmtd_name = mkloc loc s; pmtd_type = Some mt; pmtd_attributes = [];
+ pmtd_loc = loc}
+ in
+ Pstr_modtype pmtd
+;;
+
+let ocaml_pstr_module loc (s : string option) me =
+ let mb =
+ {pmb_name = mkloc loc s; pmb_expr = me; pmb_attributes = [];
+ pmb_loc = loc}
+ in
+ Pstr_module mb
+;;
+
+let ocaml_pstr_open loc li =
+ Pstr_open
+ {popen_expr =
+ {pmod_desc = Pmod_ident (mknoloc li); pmod_loc = loc_none;
+ pmod_attributes = []};
+ popen_override = Fresh; popen_loc = loc; popen_attributes = []}
+;;
+
+let ocaml_pstr_primitive s vd = Pstr_primitive vd;;
+
+let ocaml_pstr_recmodule =
+ let f nel =
+ Pstr_recmodule
+ (List.map
+ (fun ((s : string option), mt, me) ->
+ {pmb_name = mknoloc s; pmb_expr = me; pmb_attributes = [];
+ pmb_loc = loc_none})
+ nel)
+ in
+ Some f
+;;
+
+let ocaml_pstr_type is_nonrec stl =
+ let stl = List.map (fun (s, t) -> t) stl in
+ Pstr_type ((if is_nonrec then Nonrecursive else Recursive), stl)
+;;
+
+let ocaml_class_infos =
+ Some
+ (fun virt (sl, sloc) name expr loc variance ->
+ let _ =
+ if List.length sl <> List.length variance then
+ failwith "internal error: ocaml_class_infos"
+ in
+ let params =
+ List.map2
+ (fun os va ->
+ ocaml_mktyp loc (Ptyp_var os), variance_of_bool_bool va)
+ sl variance
+ in
+ {pci_virt = virt; pci_params = params; pci_name = mkloc loc name;
+ pci_expr = expr; pci_loc = loc; pci_attributes = []})
+;;
+
+let ocaml_pmod_constraint loc me mt =
+ ocaml_mkmod loc (Pmod_constraint (me, mt))
+;;
+
+let ocaml_pmod_ident li = Pmod_ident (mknoloc li);;
+
+let ocaml_pmod_functor mt me =
+ let mt =
+ match mt with
+ None -> Unit
+ | Some (idopt, mt) -> Named (mknoloc idopt, mt)
+ in
+ Pmod_functor (mt, me)
+;;
+
+let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option =
+ Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt)))
+;;
+
+let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constraint (t1, t2));;
+
+let ocaml_pcf_inher loc ce pb =
+ Pcf_inherit (Fresh, ce, option_map (mkloc loc) pb)
+;;
+
+let ocaml_pcf_init = Some (fun e -> Pcf_initializer e);;
+
+let ocaml_pcf_meth (s, pf, ovf, e, loc) =
+ let pf = if pf then Private else Public in
+ let ovf = if ovf then Override else Fresh in
+ Pcf_method (mkloc loc s, pf, Cfk_concrete (ovf, e))
+;;
+
+let ocaml_pcf_val (s, mf, ovf, e, loc) =
+ let mf = if mf then Mutable else Immutable in
+ let ovf = if ovf then Override else Fresh in
+ Pcf_val (mkloc loc s, mf, Cfk_concrete (ovf, e))
+;;
+
+let ocaml_pcf_valvirt =
+ let ocaml_pcf (s, mf, t, loc) =
+ let mf = if mf then Mutable else Immutable in
+ Pcf_val (mkloc loc s, mf, Cfk_virtual t)
+ in
+ Some ocaml_pcf
+;;
+
+let ocaml_pcf_virt (s, pf, t, loc) =
+ Pcf_method (mkloc loc s, pf, Cfk_virtual t)
+;;
+
+let ocaml_pcl_apply =
+ Some
+ (fun ce lel -> Pcl_apply (ce, List.map (fun (l, e) -> labelled l, e) lel))
+;;
+
+let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));;
+
+let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));;
+
+let ocaml_pcl_fun =
+ Some (fun lab ceo p ce -> Pcl_fun (labelled lab, ceo, p, ce))
+;;
+
+let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));;
+
+let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);;
+
+let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_constraint (t1, t2));;
+
+let ocaml_pctf_inher ct = Pctf_inherit ct;;
+
+let ocaml_pctf_meth (s, pf, t, loc) =
+ Pctf_method (mkloc loc s, pf, Concrete, t)
+;;
+
+let ocaml_pctf_val (s, mf, t, loc) = Pctf_val (mkloc loc s, mf, Concrete, t);;
+
+let ocaml_pctf_virt (s, pf, t, loc) =
+ Pctf_method (mkloc loc s, pf, Virtual, t)
+;;
+
+let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));;
+
+let ocaml_pcty_fun =
+ Some (fun lab t ot ct -> Pcty_arrow (labelled lab, t, ct))
+;;
+
+let ocaml_pcty_signature =
+ let f (t, ctfl) =
+ let cs = {pcsig_self = t; pcsig_fields = ctfl} in Pcty_signature cs
+ in
+ Some f
+;;
+
+let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);;
+let ocaml_pdir_int i s = Pdir_int (i, None);;
+let ocaml_pdir_some x = Some x;;
+let ocaml_pdir_none = None;;
+let ocaml_ptop_dir loc s da =
+ Ptop_dir
+ {pdir_name = mkloc loc s;
+ pdir_arg =
+ begin match da with
+ Some da -> Some {pdira_desc = da; pdira_loc = loc}
+ | None -> None
+ end;
+ pdir_loc = loc}
+;;
+
+let ocaml_pwith_modsubst =
+ Some (fun loc me -> Pwith_modsubst (mkloc loc (Lident ""), mkloc loc me))
+;;
+
+let ocaml_pwith_type loc (i, td) = Pwith_type (mkloc loc i, td);;
+
+let ocaml_pwith_module loc mname me =
+ Pwith_module (mkloc loc mname, mkloc loc me)
+;;
+
+let ocaml_pwith_typesubst =
+ Some (fun loc td -> Pwith_typesubst (mkloc loc (Lident ""), td))
+;;
+
+let module_prefix_can_be_in_first_record_label_only = true;;
+
+let split_or_patterns_with_bindings = false;;
+
+let has_records_with_with = true;;
+
+(* *)
+
+let jocaml_pstr_def : (_ -> _) option = None;;
+
+let jocaml_pexp_def : (_ -> _ -> _) option = None;;
+
+let jocaml_pexp_par : (_ -> _ -> _) option = None;;
+
+let jocaml_pexp_reply : (_ -> _ -> _ -> _) option = None;;
+
+let jocaml_pexp_spawn : (_ -> _) option = None;;
+
+let arg_rest =
+ function
+ Arg.Rest r -> Some r
+ | _ -> None
+;;
+
+let arg_set_string =
+ function
+ Arg.Set_string r -> Some r
+ | _ -> None
+;;
+
+let arg_set_int =
+ function
+ Arg.Set_int r -> Some r
+ | _ -> None
+;;
+
+let arg_set_float =
+ function
+ Arg.Set_float r -> Some r
+ | _ -> None
+;;
+
+let arg_symbol =
+ function
+ Arg.Symbol (s, f) -> Some (s, f)
+ | _ -> None
+;;
+
+let arg_tuple =
+ function
+ Arg.Tuple t -> Some t
+ | _ -> None
+;;
+
+let arg_bool =
+ function
+ Arg.Bool f -> Some f
+ | _ -> None
+;;
+
+let char_escaped = Char.escaped;;
+
+let hashtbl_mem = Hashtbl.mem;;
+
+let list_rev_append = List.rev_append;;
+
+let list_rev_map = List.rev_map;;
+
+let list_sort = List.sort;;
+
+let pervasives_set_binary_mode_out = set_binary_mode_out;;
+
+let printf_ksprintf = Printf.ksprintf;;
+
+let char_uppercase = Char.uppercase_ascii;;
+
+let bytes_modname = "Bytes";;
+
+let bytes_of_string s = Bytes.of_string s;;
+
+let bytes_to_string s = Bytes.to_string s;;
+
+let string_capitalize = String.capitalize_ascii;;
+
+let string_contains = String.contains;;
+
+let string_cat s1 s2 = Bytes.cat s1 s2;;
+
+let string_copy = Bytes.copy;;
+
+let string_create = Bytes.create;;
+
+let string_get = Bytes.get;;
+
+let string_index = Bytes.index;;
+
+let string_length = Bytes.length;;
+
+let string_lowercase = String.lowercase_ascii;;
+
+let string_unsafe_set = Bytes.unsafe_set;;
+
+let string_uncapitalize = String.uncapitalize_ascii;;
+
+let string_uppercase = String.uppercase_ascii;;
+
+let string_set = Bytes.set;;
+
+let string_sub = Bytes.sub;;
+
+let array_create = Array.make;;
diff --git a/ocaml_src/main/ast2pt.ml b/ocaml_src/main/ast2pt.ml
index d854c8bb..87b34922 100644
--- a/ocaml_src/main/ast2pt.ml
+++ b/ocaml_src/main/ast2pt.ml
@@ -629,7 +629,7 @@ let rec patt =
| PaStr (loc, s) ->
mkpat loc
(Ppat_constant
- (ocaml_pconst_string (string_of_string_token loc (uv s)) None))
+ (ocaml_pconst_string (string_of_string_token loc (uv s)) (mkloc loc) None))
| PaTup (loc, pl) -> mkpat loc (Ppat_tuple (List.map patt (uv pl)))
| PaTyc (loc, p, t) -> mkpat loc (Ppat_constraint (patt p, ctyp t))
| PaTyp (loc, sl) ->
@@ -1225,7 +1225,7 @@ let rec expr =
| ExStr (loc, s) ->
mkexp loc
(Pexp_constant
- (ocaml_pconst_string (string_of_string_token loc (uv s)) None))
+ (ocaml_pconst_string (string_of_string_token loc (uv s)) (mkloc loc) None))
| ExTry (loc, e, pel) ->
mkexp loc (Pexp_try (expr e, List.map mkpwe (uv pel)))
| ExTup (loc, el) -> mkexp loc (Pexp_tuple (List.map expr (uv el)))
diff --git a/ocaml_stuff/4.11.0/parsing/.depend b/ocaml_stuff/4.11.0/parsing/.depend
new file mode 100644
index 00000000..c589fb6e
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/.depend
@@ -0,0 +1,4 @@
+asttypes.cmi : location.cmi
+location.cmi : ../utils/warnings.cmi
+longident.cmi :
+parsetree.cmi : longident.cmi location.cmi asttypes.cmi
diff --git a/ocaml_stuff/4.11.0/parsing/.gitignore b/ocaml_stuff/4.11.0/parsing/.gitignore
new file mode 100644
index 00000000..8e6c39c2
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/.gitignore
@@ -0,0 +1 @@
+*.cm[oi]
diff --git a/ocaml_stuff/4.11.0/parsing/Makefile b/ocaml_stuff/4.11.0/parsing/Makefile
new file mode 100644
index 00000000..6d08a199
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/Makefile
@@ -0,0 +1,19 @@
+# Makefile,v
+
+FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi
+INCL=-I ../utils
+
+all: $(FILES)
+
+clean:
+ rm -f *.cmi
+
+depend:
+ ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend
+
+.SUFFIXES: .mli .cmi
+
+.mli.cmi:
+ $(OCAMLN)c $(INCL) -c $<
+
+include .depend
diff --git a/ocaml_stuff/4.11.0/parsing/asttypes.mli b/ocaml_stuff/4.11.0/parsing/asttypes.mli
new file mode 100644
index 00000000..353d7776
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/asttypes.mli
@@ -0,0 +1,63 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Auxiliary AST types used by parsetree and typedtree.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type 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 = Nonrecursive | Recursive
+
+type direction_flag = Upto | Downto
+
+(* Order matters, used in polymorphic comparison *)
+type private_flag = Private | Public
+
+type mutable_flag = Immutable | Mutable
+
+type virtual_flag = Virtual | Concrete
+
+type override_flag = Override | Fresh
+
+type closed_flag = Closed | Open
+
+type label = string
+
+type 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 =
+ | Covariant
+ | Contravariant
+ | Invariant
diff --git a/ocaml_stuff/4.11.0/parsing/location.mli b/ocaml_stuff/4.11.0/parsing/location.mli
new file mode 100644
index 00000000..ecf39b21
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/location.mli
@@ -0,0 +1,287 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** {1 Source code locations (ranges of positions), used in parsetree}
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Format
+
+type t = Warnings.loc = {
+ loc_start: Lexing.position;
+ loc_end: Lexing.position;
+ loc_ghost: bool;
+}
+
+(** Note on the use of Lexing.position in this module.
+ If [pos_fname = ""], then use [!input_name] instead.
+ If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
+ re-parse the file to get the line and character numbers.
+ Else all fields are correct.
+*)
+
+val none : t
+(** An arbitrary value of type [t]; describes an empty ghost range. *)
+
+val is_none : t -> bool
+(** True for [Location.none], false any other location *)
+
+val in_file : string -> t
+(** Return an empty ghost range located in a given file. *)
+
+val init : Lexing.lexbuf -> string -> unit
+(** Set the file name and line number of the [lexbuf] to be the start
+ of the named file. *)
+
+val curr : Lexing.lexbuf -> t
+(** Get the location of the current token from the [lexbuf]. *)
+
+val symbol_rloc: unit -> t
+val symbol_gloc: unit -> t
+
+(** [rhs_loc n] returns the location of the symbol at position [n], starting
+ at 1, in the current parser rule. *)
+val rhs_loc: int -> t
+
+val rhs_interval: int -> int -> t
+
+val get_pos_info: Lexing.position -> string * int * int
+(** file, line, char *)
+
+type 'a loc = {
+ txt : 'a;
+ loc : t;
+}
+
+val mknoloc : 'a -> 'a loc
+val mkloc : 'a -> t -> 'a loc
+
+
+(** {1 Input info} *)
+
+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} *)
+
+val echo_eof: unit -> unit
+val reset: unit -> unit
+
+
+(** {1 Printing locations} *)
+
+val rewrite_absolute_path: string -> string
+ (** rewrite absolute path to honor the BUILD_PATH_PREFIX_MAP
+ variable (https://reproducible-builds.org/specs/build-path-prefix-map/)
+ if it is set. *)
+
+val absolute_path: string -> string
+
+val show_filename: string -> string
+ (** In -absname mode, return the absolute path for this filename.
+ Otherwise, returns the filename unchanged. *)
+
+val print_filename: formatter -> string -> unit
+
+val print_loc: formatter -> t -> unit
+val print_locs: formatter -> t list -> unit
+
+
+(** {1 Toplevel-specific location highlighting} *)
+
+val highlight_terminfo:
+ Lexing.lexbuf -> formatter -> t list -> unit
+
+
+(** {1 Reporting errors and warnings} *)
+
+(** {2 The type of reports and report printers} *)
+
+type msg = (Format.formatter -> unit) loc
+
+val msg: ?loc:t -> ('a, Format.formatter, unit, msg) format4 -> 'a
+
+type report_kind =
+ | Report_error
+ | Report_warning of string
+ | Report_warning_as_error of string
+ | Report_alert of string
+ | Report_alert_as_error of string
+
+type report = {
+ kind : report_kind;
+ main : msg;
+ sub : msg list;
+}
+
+type report_printer = {
+ (* The entry point *)
+ pp : report_printer ->
+ Format.formatter -> report -> unit;
+
+ pp_report_kind : report_printer -> report ->
+ Format.formatter -> report_kind -> unit;
+ pp_main_loc : report_printer -> report ->
+ Format.formatter -> t -> unit;
+ pp_main_txt : report_printer -> report ->
+ Format.formatter -> (Format.formatter -> unit) -> unit;
+ pp_submsgs : report_printer -> report ->
+ Format.formatter -> msg list -> unit;
+ pp_submsg : report_printer -> report ->
+ Format.formatter -> msg -> unit;
+ pp_submsg_loc : report_printer -> report ->
+ Format.formatter -> t -> unit;
+ pp_submsg_txt : report_printer -> report ->
+ Format.formatter -> (Format.formatter -> unit) -> unit;
+}
+(** A printer for [report]s, defined using open-recursion.
+ The goal is to make it easy to define new printers by re-using code from
+ existing ones.
+*)
+
+(** {2 Report printers used in the compiler} *)
+
+val batch_mode_printer: report_printer
+
+val terminfo_toplevel_printer: Lexing.lexbuf -> report_printer
+
+val best_toplevel_printer: unit -> report_printer
+(** Detects the terminal capabilities and selects an adequate printer *)
+
+(** {2 Printing a [report]} *)
+
+val print_report: formatter -> report -> unit
+(** Display an error or warning report. *)
+
+val report_printer: (unit -> report_printer) ref
+(** Hook for redefining the printer of reports.
+
+ The hook is a [unit -> report_printer] and not simply a [report_printer]:
+ this is useful so that it can detect the type of the output (a file, a
+ terminal, ...) and select a printer accordingly. *)
+
+val default_report_printer: unit -> report_printer
+(** Original report printer for use in hooks. *)
+
+
+(** {1 Reporting warnings} *)
+
+(** {2 Converting a [Warnings.t] into a [report]} *)
+
+val report_warning: t -> Warnings.t -> report option
+(** [report_warning loc w] produces a report for the given warning [w], or
+ [None] if the warning is not to be printed. *)
+
+val warning_reporter: (t -> Warnings.t -> report option) ref
+(** Hook for intercepting warnings. *)
+
+val default_warning_reporter: t -> Warnings.t -> report option
+(** Original warning reporter for use in hooks. *)
+
+(** {2 Printing warnings} *)
+
+val formatter_for_warnings : formatter ref
+
+val print_warning: t -> formatter -> Warnings.t -> unit
+(** Prints a warning. This is simply the composition of [report_warning] and
+ [print_report]. *)
+
+val prerr_warning: t -> Warnings.t -> unit
+(** Same as [print_warning], but uses [!formatter_for_warnings] as output
+ formatter. *)
+
+(** {1 Reporting alerts} *)
+
+(** {2 Converting an [Alert.t] into a [report]} *)
+
+val report_alert: t -> Warnings.alert -> report option
+(** [report_alert loc w] produces a report for the given alert [w], or
+ [None] if the alert is not to be printed. *)
+
+val alert_reporter: (t -> Warnings.alert -> report option) ref
+(** Hook for intercepting alerts. *)
+
+val default_alert_reporter: t -> Warnings.alert -> report option
+(** Original alert reporter for use in hooks. *)
+
+(** {2 Printing alerts} *)
+
+val print_alert: t -> formatter -> Warnings.alert -> unit
+(** Prints an alert. This is simply the composition of [report_alert] and
+ [print_report]. *)
+
+val prerr_alert: t -> Warnings.alert -> unit
+(** Same as [print_alert], but uses [!formatter_for_warnings] as output
+ formatter. *)
+
+val deprecated: ?def:t -> ?use:t -> t -> string -> unit
+(** Prints a deprecation alert. *)
+
+val alert: ?def:t -> ?use:t -> kind:string -> t -> string -> unit
+(** Prints an arbitrary alert. *)
+
+
+(** {1 Reporting errors} *)
+
+type error = report
+(** An [error] is a [report] which [report_kind] must be [Report_error]. *)
+
+val error: ?loc:t -> ?sub:msg list -> string -> error
+
+val errorf: ?loc:t -> ?sub:msg list ->
+ ('a, Format.formatter, unit, error) format4 -> 'a
+
+val error_of_printer: ?loc:t -> ?sub:msg list ->
+ (formatter -> 'a -> unit) -> 'a -> error
+
+val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error
+
+
+(** {1 Automatically reporting errors for raised exceptions} *)
+
+val register_error_of_exn: (exn -> error option) -> unit
+(** Each compiler module which defines a custom type of exception
+ which can surface as a user-visible error should register
+ a "printer" for this exception using [register_error_of_exn].
+ The result of the printer is an [error] value containing
+ a location, a message, and optionally sub-messages (each of them
+ being located as well). *)
+
+val error_of_exn: exn -> [ `Ok of error | `Already_displayed ] option
+
+exception Error of error
+(** Raising [Error e] signals an error [e]; the exception will be caught and the
+ error will be printed. *)
+
+exception Already_displayed_error
+(** Raising [Already_displayed_error] signals an error which has already been
+ printed. The exception will be caught, but nothing will be printed *)
+
+val raise_errorf: ?loc:t -> ?sub:msg list ->
+ ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val report_exception: formatter -> exn -> unit
+(** Reraise the exception if it is unknown. *)
diff --git a/ocaml_stuff/4.11.0/parsing/longident.mli b/ocaml_stuff/4.11.0/parsing/longident.mli
new file mode 100644
index 00000000..07086301
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/longident.mli
@@ -0,0 +1,60 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Long identifiers, used in parsetree.
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type t =
+ Lident of string
+ | Ldot of t * string
+ | Lapply of t * t
+
+val flatten: t -> string list
+val unflatten: string list -> t option
+(** For a non-empty list [l], [unflatten l] is [Some lid] where [lid] is
+ the long identifier created by concatenating the elements of [l]
+ with [Ldot].
+ [unflatten []] is [None].
+*)
+
+val last: t -> string
+val parse: string -> t
+[@@deprecated "this function may misparse its input,\n\
+use \"Parse.longident\" or \"Longident.unflatten\""]
+(**
+
+ This function is broken on identifiers that are not just "Word.Word.word";
+ for example, it returns incorrect results on infix operators
+ and extended module paths.
+
+ If you want to generate long identifiers that are a list of
+ dot-separated identifiers, the function {!unflatten} is safer and faster.
+ {!unflatten} is available since OCaml 4.06.0.
+
+ If you want to parse any identifier correctly, use the long-identifiers
+ functions from the {!Parse} module, in particular {!Parse.longident}.
+ They are available since OCaml 4.11, and also provide proper
+ input-location support.
+
+*)
+
+
+
+(** To print a longident, see {!Pprintast.longident}, using
+ {!Format.asprintf} to convert to a string. *)
diff --git a/ocaml_stuff/4.11.0/parsing/parsetree.mli b/ocaml_stuff/4.11.0/parsing/parsetree.mli
new file mode 100644
index 00000000..0712f87c
--- /dev/null
+++ b/ocaml_stuff/4.11.0/parsing/parsetree.mli
@@ -0,0 +1,970 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Abstract syntax tree produced by parsing
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+open Asttypes
+
+type constant =
+ Pconst_integer of string * char option
+ (* 3 3l 3L 3n
+
+ Suffixes [g-z][G-Z] are accepted by the parser.
+ Suffixes except 'l', 'L' and 'n' are rejected by the typechecker
+ *)
+ | Pconst_char of char
+ (* 'c' *)
+ | Pconst_string of string * Location.t * string option
+ (* "constant"
+ {delim|other constant|delim}
+
+ The location span the content of the string, without the delimiters.
+ *)
+ | Pconst_float of string * char option
+ (* 3.4 2e5 1.4e-4
+
+ Suffixes [g-z][G-Z] are accepted by the parser.
+ Suffixes are rejected by the typechecker.
+ *)
+
+type location_stack = Location.t list
+
+(** {1 Extension points} *)
+
+type attribute = {
+ attr_name : string loc;
+ attr_payload : payload;
+ attr_loc : Location.t;
+ }
+ (* [@id ARG]
+ [@@id ARG]
+
+ Metadata containers passed around within the AST.
+ The compiler ignores unknown attributes.
+ *)
+
+and extension = string loc * payload
+ (* [%id ARG]
+ [%%id ARG]
+
+ Sub-language placeholder -- rejected by the typechecker.
+ *)
+
+and attributes = attribute list
+
+and payload =
+ | PStr of structure
+ | PSig of signature (* : SIG *)
+ | PTyp of core_type (* : T *)
+ | PPat of pattern * expression option (* ? P or ? P when E *)
+
+(** {1 Core language} *)
+
+(* Type expressions *)
+
+and core_type =
+ {
+ ptyp_desc: core_type_desc;
+ ptyp_loc: Location.t;
+ ptyp_loc_stack: location_stack;
+ ptyp_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and core_type_desc =
+ | Ptyp_any
+ (* _ *)
+ | Ptyp_var of string
+ (* 'a *)
+ | Ptyp_arrow of arg_label * core_type * core_type
+ (* T1 -> T2 Simple
+ ~l:T1 -> T2 Labelled
+ ?l:T1 -> T2 Optional
+ *)
+ | Ptyp_tuple of core_type list
+ (* T1 * ... * Tn
+
+ Invariant: n >= 2
+ *)
+ | Ptyp_constr of Longident.t loc * core_type list
+ (* tconstr
+ T tconstr
+ (T1, ..., Tn) tconstr
+ *)
+ | Ptyp_object of object_field list * closed_flag
+ (* < l1:T1; ...; ln:Tn > (flag = Closed)
+ < l1:T1; ...; ln:Tn; .. > (flag = Open)
+ *)
+ | Ptyp_class of Longident.t loc * core_type list
+ (* #tconstr
+ T #tconstr
+ (T1, ..., Tn) #tconstr
+ *)
+ | Ptyp_alias of core_type * string
+ (* T as 'a *)
+ | Ptyp_variant of row_field list * closed_flag * label list option
+ (* [ `A|`B ] (flag = Closed; labels = None)
+ [> `A|`B ] (flag = Open; labels = None)
+ [< `A|`B ] (flag = Closed; labels = Some [])
+ [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"])
+ *)
+ | Ptyp_poly of string loc list * core_type
+ (* 'a1 ... 'an. T
+
+ Can only appear in the following context:
+
+ - As the core_type of a Ppat_constraint node corresponding
+ to a constraint on a let-binding: let x : 'a1 ... 'an. T
+ = e ...
+
+ - Under Cfk_virtual for methods (not values).
+
+ - As the core_type of a Pctf_method node.
+
+ - As the core_type of a Pexp_poly node.
+
+ - As the pld_type field of a label_declaration.
+
+ - As a core_type of a Ptyp_object node.
+ *)
+
+ | Ptyp_package of package_type
+ (* (module S) *)
+ | Ptyp_extension of extension
+ (* [%id] *)
+
+and package_type = Longident.t loc * (Longident.t loc * core_type) list
+ (*
+ (module S)
+ (module S with type t1 = T1 and ... and tn = Tn)
+ *)
+
+and row_field = {
+ prf_desc : row_field_desc;
+ prf_loc : Location.t;
+ prf_attributes : attributes;
+}
+
+and row_field_desc =
+ | Rtag of label loc * bool * core_type list
+ (* [`A] ( true, [] )
+ [`A of T] ( false, [T] )
+ [`A of T1 & .. & Tn] ( false, [T1;...Tn] )
+ [`A of & T1 & .. & Tn] ( true, [T1;...Tn] )
+
+ - The 'bool' field is true if the tag contains a
+ constant (empty) constructor.
+ - '&' occurs when several types are used for the same constructor
+ (see 4.2 in the manual)
+ *)
+ | Rinherit of core_type
+ (* [ T ] *)
+
+and object_field = {
+ pof_desc : object_field_desc;
+ pof_loc : Location.t;
+ pof_attributes : attributes;
+}
+
+and object_field_desc =
+ | Otag of label loc * core_type
+ | Oinherit of core_type
+
+(* Patterns *)
+
+and pattern =
+ {
+ ppat_desc: pattern_desc;
+ ppat_loc: Location.t;
+ ppat_loc_stack: location_stack;
+ ppat_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and pattern_desc =
+ | Ppat_any
+ (* _ *)
+ | Ppat_var of string loc
+ (* x *)
+ | Ppat_alias of pattern * string loc
+ (* P as 'a *)
+ | Ppat_constant of constant
+ (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ | Ppat_interval of constant * constant
+ (* 'a'..'z'
+
+ Other forms of interval are recognized by the parser
+ but rejected by the type-checker. *)
+ | Ppat_tuple of pattern list
+ (* (P1, ..., Pn)
+
+ Invariant: n >= 2
+ *)
+ | Ppat_construct of Longident.t loc * pattern option
+ (* C None
+ C P Some P
+ C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn])
+ *)
+ | Ppat_variant of label * pattern option
+ (* `A (None)
+ `A P (Some P)
+ *)
+ | Ppat_record of (Longident.t loc * pattern) list * closed_flag
+ (* { l1=P1; ...; ln=Pn } (flag = Closed)
+ { l1=P1; ...; ln=Pn; _} (flag = Open)
+
+ Invariant: n > 0
+ *)
+ | Ppat_array of pattern list
+ (* [| P1; ...; Pn |] *)
+ | Ppat_or of pattern * pattern
+ (* P1 | P2 *)
+ | Ppat_constraint of pattern * core_type
+ (* (P : T) *)
+ | Ppat_type of Longident.t loc
+ (* #tconst *)
+ | Ppat_lazy of pattern
+ (* lazy 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)
+ *)
+ | Ppat_exception of pattern
+ (* exception P *)
+ | Ppat_extension of extension
+ (* [%id] *)
+ | Ppat_open of Longident.t loc * pattern
+ (* M.(P) *)
+
+(* Value expressions *)
+
+and expression =
+ {
+ pexp_desc: expression_desc;
+ pexp_loc: Location.t;
+ pexp_loc_stack: location_stack;
+ pexp_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and expression_desc =
+ | Pexp_ident of Longident.t loc
+ (* x
+ M.x
+ *)
+ | Pexp_constant of constant
+ (* 1, 'a', "true", 1.0, 1l, 1L, 1n *)
+ | Pexp_let of rec_flag * value_binding list * expression
+ (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive)
+ let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive)
+ *)
+ | Pexp_function of case list
+ (* function P1 -> E1 | ... | Pn -> En *)
+ | Pexp_fun of arg_label * expression option * pattern * expression
+ (* fun P -> E1 (Simple, None)
+ fun ~l:P -> E1 (Labelled l, None)
+ fun ?l:P -> E1 (Optional l, None)
+ fun ?l:(P = E0) -> E1 (Optional l, Some E0)
+
+ Notes:
+ - If E0 is provided, only Optional is allowed.
+ - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun.
+ - "let f P = E" is represented using Pexp_fun.
+ *)
+ | Pexp_apply of expression * (arg_label * expression) list
+ (* E0 ~l1:E1 ... ~ln:En
+ li can be empty (non labeled argument) or start with '?'
+ (optional argument).
+
+ Invariant: n > 0
+ *)
+ | Pexp_match of expression * case list
+ (* match E0 with P1 -> E1 | ... | Pn -> En *)
+ | Pexp_try of expression * case list
+ (* try E0 with P1 -> E1 | ... | Pn -> En *)
+ | Pexp_tuple of expression list
+ (* (E1, ..., En)
+
+ Invariant: n >= 2
+ *)
+ | Pexp_construct of Longident.t loc * expression option
+ (* C None
+ C E Some E
+ C (E1, ..., En) Some (Pexp_tuple[E1;...;En])
+ *)
+ | Pexp_variant of label * expression option
+ (* `A (None)
+ `A E (Some E)
+ *)
+ | Pexp_record of (Longident.t loc * expression) list * expression option
+ (* { l1=P1; ...; ln=Pn } (None)
+ { E0 with l1=P1; ...; ln=Pn } (Some E0)
+
+ Invariant: n > 0
+ *)
+ | Pexp_field of expression * Longident.t loc
+ (* E.l *)
+ | Pexp_setfield of expression * Longident.t loc * expression
+ (* E1.l <- E2 *)
+ | Pexp_array of expression list
+ (* [| E1; ...; En |] *)
+ | Pexp_ifthenelse of expression * expression * expression option
+ (* if E1 then E2 else E3 *)
+ | Pexp_sequence of expression * expression
+ (* E1; E2 *)
+ | Pexp_while of expression * expression
+ (* while E1 do E2 done *)
+ | Pexp_for of
+ pattern * expression * expression * direction_flag * expression
+ (* for i = E1 to E2 do E3 done (flag = Upto)
+ for i = E1 downto E2 do E3 done (flag = Downto)
+ *)
+ | Pexp_constraint of expression * core_type
+ (* (E : T) *)
+ | Pexp_coerce of expression * core_type option * core_type
+ (* (E :> T) (None, T)
+ (E : T0 :> T) (Some T0, T)
+ *)
+ | Pexp_send of expression * label loc
+ (* E # m *)
+ | Pexp_new of Longident.t loc
+ (* new M.c *)
+ | Pexp_setinstvar of label loc * expression
+ (* x <- 2 *)
+ | Pexp_override of (label loc * expression) list
+ (* {< x1 = E1; ...; Xn = En >} *)
+ | 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 *)
+ | Pexp_assert of expression
+ (* assert E
+ Note: "assert false" is treated in a special way by the
+ type-checker. *)
+ | Pexp_lazy of expression
+ (* lazy E *)
+ | Pexp_poly of expression * core_type option
+ (* Used for method bodies.
+
+ Can only be used as the expression under Cfk_concrete
+ for methods (not values). *)
+ | Pexp_object of class_structure
+ (* object ... end *)
+ | Pexp_newtype of string loc * expression
+ (* fun (type t) -> E *)
+ | Pexp_pack of module_expr
+ (* (module ME)
+
+ (module ME : S) is represented as
+ Pexp_constraint(Pexp_pack, Ptyp_package S) *)
+ | Pexp_open of open_declaration * expression
+ (* M.(E)
+ let open M in E
+ let! open M in E *)
+ | Pexp_letop of letop
+ (* let* P = E in E
+ let* P = E and* P = E in E *)
+ | Pexp_extension of extension
+ (* [%id] *)
+ | Pexp_unreachable
+ (* . *)
+
+and case = (* (P -> E) or (P when E0 -> E) *)
+ {
+ pc_lhs: pattern;
+ pc_guard: expression option;
+ pc_rhs: expression;
+ }
+
+and letop =
+ {
+ let_ : binding_op;
+ ands : binding_op list;
+ body : expression;
+ }
+
+and binding_op =
+ {
+ pbop_op : string loc;
+ pbop_pat : pattern;
+ pbop_exp : expression;
+ pbop_loc : Location.t;
+ }
+
+(* Value descriptions *)
+
+and value_description =
+ {
+ pval_name: string loc;
+ pval_type: core_type;
+ pval_prim: string list;
+ pval_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pval_loc: Location.t;
+ }
+
+(*
+ val x: T (prim = [])
+ external x: T = "s1" ... "sn" (prim = ["s1";..."sn"])
+*)
+
+(* Type declarations *)
+
+and type_declaration =
+ {
+ ptype_name: string loc;
+ ptype_params: (core_type * variance) list;
+ (* ('a1,...'an) t; None represents _*)
+ ptype_cstrs: (core_type * core_type * Location.t) list;
+ (* ... constraint T1=T1' ... constraint Tn=Tn' *)
+ ptype_kind: type_kind;
+ ptype_private: private_flag; (* = private ... *)
+ ptype_manifest: core_type option; (* = T *)
+ ptype_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ ptype_loc: Location.t;
+ }
+
+(*
+ type t (abstract, no manifest)
+ type t = T0 (abstract, manifest=T0)
+ type t = C of T | ... (variant, no manifest)
+ type t = T0 = C of T | ... (variant, manifest=T0)
+ type t = {l: T; ...} (record, no manifest)
+ type t = T0 = {l : T; ...} (record, manifest=T0)
+ type t = .. (open, no manifest)
+*)
+
+and type_kind =
+ | Ptype_abstract
+ | Ptype_variant of constructor_declaration list
+ | Ptype_record of label_declaration list
+ (* Invariant: non-empty list *)
+ | Ptype_open
+
+and label_declaration =
+ {
+ pld_name: string loc;
+ pld_mutable: mutable_flag;
+ pld_type: core_type;
+ pld_loc: Location.t;
+ pld_attributes: attributes; (* l : T [@id1] [@id2] *)
+ }
+
+(* { ...; l: T; ... } (mutable=Immutable)
+ { ...; mutable l: T; ... } (mutable=Mutable)
+
+ Note: T can be a Ptyp_poly.
+*)
+
+and constructor_declaration =
+ {
+ pcd_name: string loc;
+ pcd_args: constructor_arguments;
+ pcd_res: core_type option;
+ pcd_loc: Location.t;
+ pcd_attributes: attributes; (* C of ... [@id1] [@id2] *)
+ }
+
+and constructor_arguments =
+ | Pcstr_tuple of core_type list
+ | Pcstr_record of label_declaration list
+
+(*
+ | C of T1 * ... * Tn (res = None, args = Pcstr_tuple [])
+ | C: T0 (res = Some T0, args = [])
+ | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple)
+ | C of {...} (res = None, args = Pcstr_record)
+ | C: {...} -> T0 (res = Some T0, args = Pcstr_record)
+ | C of {...} as t (res = None, args = Pcstr_record)
+*)
+
+and type_extension =
+ {
+ ptyext_path: Longident.t loc;
+ ptyext_params: (core_type * variance) list;
+ ptyext_constructors: extension_constructor list;
+ ptyext_private: private_flag;
+ ptyext_loc: Location.t;
+ ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ }
+(*
+ type t += ...
+*)
+
+and extension_constructor =
+ {
+ pext_name: string loc;
+ pext_kind : extension_constructor_kind;
+ pext_loc : Location.t;
+ pext_attributes: attributes; (* C of ... [@id1] [@id2] *)
+ }
+
+(* exception E *)
+and type_exception =
+ {
+ ptyexn_constructor: extension_constructor;
+ ptyexn_loc: Location.t;
+ ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ }
+
+and extension_constructor_kind =
+ Pext_decl of constructor_arguments * core_type option
+ (*
+ | C of T1 * ... * Tn ([T1; ...; Tn], None)
+ | C: T0 ([], Some T0)
+ | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0)
+ *)
+ | Pext_rebind of Longident.t loc
+ (*
+ | C = D
+ *)
+
+(** {1 Class language} *)
+
+(* Type expressions for the class language *)
+
+and class_type =
+ {
+ pcty_desc: class_type_desc;
+ pcty_loc: Location.t;
+ pcty_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and class_type_desc =
+ | Pcty_constr of Longident.t loc * core_type list
+ (* c
+ ['a1, ..., 'an] c *)
+ | Pcty_signature of class_signature
+ (* object ... end *)
+ | Pcty_arrow of arg_label * core_type * class_type
+ (* T -> CT Simple
+ ~l:T -> CT Labelled l
+ ?l:T -> CT Optional l
+ *)
+ | Pcty_extension of extension
+ (* [%id] *)
+ | Pcty_open of open_description * class_type
+ (* let open M in CT *)
+
+and class_signature =
+ {
+ pcsig_self: core_type;
+ pcsig_fields: class_type_field list;
+ }
+(* object('selfpat) ... end
+ object ... end (self = Ptyp_any)
+ *)
+
+and class_type_field =
+ {
+ pctf_desc: class_type_field_desc;
+ pctf_loc: Location.t;
+ pctf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ }
+
+and class_type_field_desc =
+ | Pctf_inherit of class_type
+ (* inherit CT *)
+ | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type)
+ (* val x: T *)
+ | Pctf_method of (label loc * private_flag * virtual_flag * core_type)
+ (* method x: T
+
+ Note: T can be a Ptyp_poly.
+ *)
+ | Pctf_constraint of (core_type * core_type)
+ (* constraint T1 = T2 *)
+ | Pctf_attribute of attribute
+ (* [@@@id] *)
+ | Pctf_extension of extension
+ (* [%%id] *)
+
+and 'a class_infos =
+ {
+ pci_virt: virtual_flag;
+ pci_params: (core_type * variance) list;
+ pci_name: string loc;
+ pci_expr: 'a;
+ pci_loc: Location.t;
+ pci_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ }
+(* class c = ...
+ class ['a1,...,'an] c = ...
+ class virtual c = ...
+
+ Also used for "class type" declaration.
+*)
+
+and class_description = class_type class_infos
+
+and class_type_declaration = class_type class_infos
+
+(* Value expressions for the class language *)
+
+and class_expr =
+ {
+ pcl_desc: class_expr_desc;
+ pcl_loc: Location.t;
+ pcl_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and class_expr_desc =
+ | Pcl_constr of Longident.t loc * core_type list
+ (* c
+ ['a1, ..., 'an] c *)
+ | Pcl_structure of class_structure
+ (* object ... end *)
+ | Pcl_fun of arg_label * expression option * pattern * class_expr
+ (* fun P -> CE (Simple, None)
+ fun ~l:P -> CE (Labelled l, None)
+ fun ?l:P -> CE (Optional l, None)
+ fun ?l:(P = E0) -> CE (Optional l, Some E0)
+ *)
+ | Pcl_apply of class_expr * (arg_label * expression) list
+ (* CE ~l1:E1 ... ~ln:En
+ li can be empty (non labeled argument) or start with '?'
+ (optional argument).
+
+ Invariant: n > 0
+ *)
+ | Pcl_let of rec_flag * value_binding list * class_expr
+ (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive)
+ let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive)
+ *)
+ | Pcl_constraint of class_expr * class_type
+ (* (CE : CT) *)
+ | Pcl_extension of extension
+ (* [%id] *)
+ | Pcl_open of open_description * class_expr
+ (* let open M in CE *)
+
+
+and class_structure =
+ {
+ pcstr_self: pattern;
+ pcstr_fields: class_field list;
+ }
+(* object(selfpat) ... end
+ object ... end (self = Ppat_any)
+ *)
+
+and class_field =
+ {
+ pcf_desc: class_field_desc;
+ pcf_loc: Location.t;
+ pcf_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ }
+
+and class_field_desc =
+ | Pcf_inherit of override_flag * class_expr * string loc option
+ (* inherit CE
+ inherit CE as x
+ inherit! CE
+ inherit! CE as x
+ *)
+ | Pcf_val of (label loc * mutable_flag * class_field_kind)
+ (* val x = E
+ val virtual x: T
+ *)
+ | Pcf_method of (label loc * private_flag * class_field_kind)
+ (* method x = E (E can be a Pexp_poly)
+ method virtual x: T (T can be a Ptyp_poly)
+ *)
+ | Pcf_constraint of (core_type * core_type)
+ (* constraint T1 = T2 *)
+ | Pcf_initializer of expression
+ (* initializer E *)
+ | Pcf_attribute of attribute
+ (* [@@@id] *)
+ | Pcf_extension of extension
+ (* [%%id] *)
+
+and class_field_kind =
+ | Cfk_virtual of core_type
+ | Cfk_concrete of override_flag * expression
+
+and class_declaration = class_expr class_infos
+
+(** {1 Module language} *)
+
+(* Type expressions for the module language *)
+
+and module_type =
+ {
+ pmty_desc: module_type_desc;
+ pmty_loc: Location.t;
+ pmty_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and module_type_desc =
+ | Pmty_ident of Longident.t loc
+ (* S *)
+ | Pmty_signature of signature
+ (* sig ... end *)
+ | Pmty_functor of functor_parameter * module_type
+ (* functor(X : MT1) -> MT2 *)
+ | Pmty_with of module_type * with_constraint list
+ (* MT with ... *)
+ | Pmty_typeof of module_expr
+ (* module type of ME *)
+ | Pmty_extension of extension
+ (* [%id] *)
+ | 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 =
+ {
+ psig_desc: signature_item_desc;
+ psig_loc: Location.t;
+ }
+
+and signature_item_desc =
+ | Psig_value of value_description
+ (*
+ val x: T
+ external x: T = "s1" ... "sn"
+ *)
+ | Psig_type of rec_flag * type_declaration list
+ (* type t1 = ... and ... and tn = ... *)
+ | Psig_typesubst of type_declaration list
+ (* type t1 := ... and ... and tn := ... *)
+ | Psig_typext of type_extension
+ (* type t1 += ... *)
+ | Psig_exception of type_exception
+ (* exception C of T *)
+ | Psig_module of module_declaration
+ (* module X = M
+ module X : MT *)
+ | Psig_modsubst of module_substitution
+ (* module X := M *)
+ | Psig_recmodule of module_declaration list
+ (* module rec X1 : MT1 and ... and Xn : MTn *)
+ | Psig_modtype of module_type_declaration
+ (* module type S = MT
+ module type S *)
+ | Psig_open of open_description
+ (* open X *)
+ | Psig_include of include_description
+ (* include MT *)
+ | Psig_class of class_description list
+ (* class c1 : ... and ... and cn : ... *)
+ | Psig_class_type of class_type_declaration list
+ (* class type ct1 = ... and ... and ctn = ... *)
+ | Psig_attribute of attribute
+ (* [@@@id] *)
+ | Psig_extension of extension * attributes
+ (* [%%id] *)
+
+and module_declaration =
+ {
+ pmd_name: string option loc;
+ pmd_type: module_type;
+ pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pmd_loc: Location.t;
+ }
+(* S : MT *)
+
+and module_substitution =
+ {
+ pms_name: string loc;
+ pms_manifest: Longident.t loc;
+ pms_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pms_loc: Location.t;
+ }
+
+and module_type_declaration =
+ {
+ pmtd_name: string loc;
+ pmtd_type: module_type option;
+ pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+ pmtd_loc: Location.t;
+ }
+(* S = MT
+ S (abstract module type declaration, pmtd_type = None)
+*)
+
+and 'a open_infos =
+ {
+ popen_expr: 'a;
+ popen_override: override_flag;
+ popen_loc: Location.t;
+ popen_attributes: attributes;
+ }
+(* open! X - popen_override = Override (silences the 'used identifier
+ shadowing' warning)
+ open X - popen_override = Fresh
+ *)
+
+and open_description = Longident.t loc open_infos
+(* open M.N
+ open M(N).O *)
+
+and open_declaration = module_expr open_infos
+(* open M.N
+ open M(N).O
+ open struct ... end *)
+
+and 'a include_infos =
+ {
+ pincl_mod: 'a;
+ pincl_loc: Location.t;
+ pincl_attributes: attributes;
+ }
+
+and include_description = module_type include_infos
+(* include MT *)
+
+and include_declaration = module_expr include_infos
+(* include ME *)
+
+and with_constraint =
+ | Pwith_type of Longident.t loc * type_declaration
+ (* with type X.t = ...
+
+ Note: the last component of the longident must match
+ the name of the type_declaration. *)
+ | Pwith_module of Longident.t loc * Longident.t loc
+ (* with module X.Y = Z *)
+ | Pwith_typesubst of Longident.t loc * type_declaration
+ (* with type X.t := ..., same format as [Pwith_type] *)
+ | Pwith_modsubst of Longident.t loc * Longident.t loc
+ (* with module X.Y := Z *)
+
+(* Value expressions for the module language *)
+
+and module_expr =
+ {
+ pmod_desc: module_expr_desc;
+ pmod_loc: Location.t;
+ pmod_attributes: attributes; (* ... [@id1] [@id2] *)
+ }
+
+and module_expr_desc =
+ | Pmod_ident of Longident.t loc
+ (* X *)
+ | Pmod_structure of structure
+ (* struct ... end *)
+ | Pmod_functor of functor_parameter * module_expr
+ (* functor(X : MT1) -> ME *)
+ | Pmod_apply of module_expr * module_expr
+ (* ME1(ME2) *)
+ | Pmod_constraint of module_expr * module_type
+ (* (ME : MT) *)
+ | Pmod_unpack of expression
+ (* (val E) *)
+ | Pmod_extension of extension
+ (* [%id] *)
+
+and structure = structure_item list
+
+and structure_item =
+ {
+ pstr_desc: structure_item_desc;
+ pstr_loc: Location.t;
+ }
+
+and structure_item_desc =
+ | Pstr_eval of expression * attributes
+ (* E *)
+ | Pstr_value of rec_flag * value_binding list
+ (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive)
+ let rec P1 = E1 and ... and Pn = EN (flag = Recursive)
+ *)
+ | Pstr_primitive of value_description
+ (* val x: T
+ external x: T = "s1" ... "sn" *)
+ | Pstr_type of rec_flag * type_declaration list
+ (* type t1 = ... and ... and tn = ... *)
+ | Pstr_typext of type_extension
+ (* type t1 += ... *)
+ | Pstr_exception of type_exception
+ (* exception C of T
+ exception C = M.X *)
+ | Pstr_module of module_binding
+ (* module X = ME *)
+ | Pstr_recmodule of module_binding list
+ (* module rec X1 = ME1 and ... and Xn = MEn *)
+ | Pstr_modtype of module_type_declaration
+ (* module type S = MT *)
+ | Pstr_open of open_declaration
+ (* open X *)
+ | Pstr_class of class_declaration list
+ (* class c1 = ... and ... and cn = ... *)
+ | Pstr_class_type of class_type_declaration list
+ (* class type ct1 = ... and ... and ctn = ... *)
+ | Pstr_include of include_declaration
+ (* include ME *)
+ | Pstr_attribute of attribute
+ (* [@@@id] *)
+ | Pstr_extension of extension * attributes
+ (* [%%id] *)
+
+and value_binding =
+ {
+ pvb_pat: pattern;
+ pvb_expr: expression;
+ pvb_attributes: attributes;
+ pvb_loc: Location.t;
+ }
+
+and module_binding =
+ {
+ pmb_name: string option loc;
+ pmb_expr: module_expr;
+ pmb_attributes: attributes;
+ pmb_loc: Location.t;
+ }
+(* X = ME *)
+
+(** {1 Toplevel} *)
+
+(* Toplevel phrases *)
+
+type toplevel_phrase =
+ | Ptop_def of structure
+ | Ptop_dir of toplevel_directive
+ (* #use, #load ... *)
+
+and toplevel_directive =
+ {
+ pdir_name : string loc;
+ pdir_arg : directive_argument option;
+ pdir_loc : Location.t;
+ }
+
+and directive_argument =
+ {
+ pdira_desc : directive_argument_desc;
+ pdira_loc : Location.t;
+ }
+
+and directive_argument_desc =
+ | Pdir_string of string
+ | Pdir_int of string * char option
+ | Pdir_ident of Longident.t
+ | Pdir_bool of bool
diff --git a/ocaml_stuff/4.11.0/utils/.depend b/ocaml_stuff/4.11.0/utils/.depend
new file mode 100644
index 00000000..b261ffe0
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/.depend
@@ -0,0 +1,2 @@
+pconfig.cmo: pconfig.cmi
+pconfig.cmx: pconfig.cmi
diff --git a/ocaml_stuff/4.11.0/utils/.gitignore b/ocaml_stuff/4.11.0/utils/.gitignore
new file mode 100644
index 00000000..23e90de9
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/.gitignore
@@ -0,0 +1 @@
+*.cm[oix]
diff --git a/ocaml_stuff/4.11.0/utils/Makefile b/ocaml_stuff/4.11.0/utils/Makefile
new file mode 100644
index 00000000..f4ea2816
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/Makefile
@@ -0,0 +1,27 @@
+# Makefile,v
+
+FILES=warnings.cmi pconfig.cmo
+INCL=
+
+all: $(FILES)
+
+opt: pconfig.cmx
+
+clean:
+ rm -f *.cm[oix] *.o
+
+depend:
+ ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend
+
+.SUFFIXES: .mli .cmi .ml .cmo .cmx
+
+.mli.cmi:
+ $(OCAMLN)c $(INCL) -c $<
+
+.ml.cmo:
+ $(OCAMLN)c $(INCL) -c $<
+
+.ml.cmx:
+ $(OCAMLN)opt $(INCL) -c $<
+
+include .depend
diff --git a/ocaml_stuff/4.11.0/utils/pconfig.ml b/ocaml_stuff/4.11.0/utils/pconfig.ml
new file mode 100644
index 00000000..cc05fde1
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/pconfig.ml
@@ -0,0 +1,2 @@
+let ast_impl_magic_number = "Caml1999M027"
+let ast_intf_magic_number = "Caml1999N027"
diff --git a/ocaml_stuff/4.11.0/utils/pconfig.mli b/ocaml_stuff/4.11.0/utils/pconfig.mli
new file mode 100644
index 00000000..6a2af67d
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/pconfig.mli
@@ -0,0 +1,2 @@
+val ast_impl_magic_number : string
+val ast_intf_magic_number : string
diff --git a/ocaml_stuff/4.11.0/utils/warnings.mli b/ocaml_stuff/4.11.0/utils/warnings.mli
new file mode 100644
index 00000000..b80ab34c
--- /dev/null
+++ b/ocaml_stuff/4.11.0/utils/warnings.mli
@@ -0,0 +1,140 @@
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1998 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Warning definitions
+
+ {b Warning:} this module is unstable and part of
+ {{!Compiler_libs}compiler-libs}.
+
+*)
+
+type loc = {
+ loc_start: Lexing.position;
+ loc_end: Lexing.position;
+ loc_ghost: bool;
+}
+
+type t =
+ | Comment_start (* 1 *)
+ | Comment_not_end (* 2 *)
+(*| Deprecated --> alert "deprecated" *) (* 3 *)
+ | Fragile_match of string (* 4 *)
+ | Partial_application (* 5 *)
+ | Labels_omitted of string list (* 6 *)
+ | Method_override of string list (* 7 *)
+ | Partial_match of string (* 8 *)
+ | Non_closed_record_pattern of string (* 9 *)
+ | Statement_type (* 10 *)
+ | Unused_match (* 11 *)
+ | Unused_pat (* 12 *)
+ | Instance_variable_override of string list (* 13 *)
+ | Illegal_backslash (* 14 *)
+ | Implicit_public_methods of string list (* 15 *)
+ | Unerasable_optional_argument (* 16 *)
+ | Undeclared_virtual_method of string (* 17 *)
+ | Not_principal of string (* 18 *)
+ | Without_principality of string (* 19 *)
+ | Unused_argument (* 20 *)
+ | Nonreturning_statement (* 21 *)
+ | Preprocessor of string (* 22 *)
+ | Useless_record_with (* 23 *)
+ | Bad_module_name of string (* 24 *)
+ | All_clauses_guarded (* 8, used to be 25 *)
+ | Unused_var of string (* 26 *)
+ | Unused_var_strict of string (* 27 *)
+ | Wildcard_arg_to_constant_constr (* 28 *)
+ | Eol_in_string (* 29 *)
+ | Duplicate_definitions of string * string * string * string (* 30 *)
+ | Multiple_definition of string * string * string (* 31 *)
+ | Unused_value_declaration of string (* 32 *)
+ | Unused_open of string (* 33 *)
+ | Unused_type_declaration of string (* 34 *)
+ | Unused_for_index of string (* 35 *)
+ | Unused_ancestor of string (* 36 *)
+ | Unused_constructor of string * bool * bool (* 37 *)
+ | Unused_extension of string * bool * bool * bool (* 38 *)
+ | Unused_rec_flag (* 39 *)
+ | Name_out_of_scope of string * string list * bool (* 40 *)
+ | Ambiguous_name of string list * string list * bool * string (* 41 *)
+ | Disambiguated_name of string (* 42 *)
+ | Nonoptional_label of string (* 43 *)
+ | Open_shadow_identifier of string * string (* 44 *)
+ | Open_shadow_label_constructor of string * string (* 45 *)
+ | Bad_env_variable of string * string (* 46 *)
+ | Attribute_payload of string * string (* 47 *)
+ | Eliminated_optional_arguments of string list (* 48 *)
+ | No_cmi_file of string * string option (* 49 *)
+ | Bad_docstring of bool (* 50 *)
+ | Expect_tailcall (* 51 *)
+ | Fragile_literal_pattern (* 52 *)
+ | Misplaced_attribute of string (* 53 *)
+ | Duplicated_attribute of string (* 54 *)
+ | Inlining_impossible of string (* 55 *)
+ | Unreachable_case (* 56 *)
+ | Ambiguous_pattern of string list (* 57 *)
+ | No_cmx_file of string (* 58 *)
+ | Assignment_to_non_mutable_value (* 59 *)
+ | Unused_module of string (* 60 *)
+ | Unboxable_type_in_prim_decl of string (* 61 *)
+ | Constraint_on_gadt (* 62 *)
+ | Erroneous_printed_signature of string (* 63 *)
+ | 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}
+
+val parse_options : bool -> string -> unit;;
+
+val parse_alert_option: string -> unit
+ (** Disable/enable alerts based on the parameter to the -alert
+ command-line option. Raises [Arg.Bad] if the string is not a
+ valid specification.
+ *)
+
+val without_warnings : (unit -> 'a) -> 'a
+ (** Run the thunk with all warnings and alerts disabled. *)
+
+val is_active : t -> bool;;
+val is_error : t -> bool;;
+
+val defaults_w : string;;
+val defaults_warn_error : string;;
+
+type reporting_information =
+ { id : string
+ ; message : string
+ ; is_error : bool
+ ; sub_locs : (loc * string) list;
+ }
+
+val report : t -> [ `Active of reporting_information | `Inactive ]
+val report_alert : alert -> [ `Active of reporting_information | `Inactive ]
+
+exception Errors;;
+
+val check_fatal : unit -> unit;;
+val reset_fatal: unit -> unit
+
+val help_warnings: unit -> unit
+
+type state
+val backup: unit -> state
+val restore: state -> unit
+val mk_lazy: (unit -> 'a) -> 'a Lazy.t
+ (** Like [Lazy.of_fun], but the function is applied with
+ the warning/alert settings at the time [mk_lazy] is called. *)
--
2.24.1
Reference in New Issue View Git Blame Copy Permalink